动态查找功能 - 循​​环显示所有工作表

时间:2018-02-01 21:52:41

标签: excel vba excel-vba

并希望.Find仅在循环中的当前工作表上发送文字

遇到这个问题,我的代码循环遍历工作簿中的每个工作表,并将拆分/保存为唯一的工作簿。我想根据该表上找到的每个特定信息命名每张表。目前我的循环正在工作,但我正在使用.Find只在第一张纸上找到文字。

有没有办法在.Find代码中定义要搜索的工作表,接下来会想到,但我真的只希望它在每个循环的当前工作表中搜索。非常感谢您提供的任何提示!

P.S。不幸的是,每张纸的间距都不同,这就是为什么我需要它来搜索特定文本时的动态。

Sub Splitbook()
    Dim wb As Workbook
    Dim xWs As Worksheet
    Dim emplID As String
    Dim LastName As Variant
    Dim FirstName As Variant
    Dim I As Long
    Dim Time As String

    Set wb = ThisWorkbook

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    I = 1

    For Each xWs In wb.Worksheets
        emplID = ""
        Cells.Find(What:="EmplID:", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        emplID = ActiveCell
        emplID = Right(emplID, 6)
        Sheets("Tracker").Range("A" & I) = emplID
        I = I + 1
        Time = Format(Now, "yyyy-mm-dd hh-mm-ss")
        xWs.Copy
        Application.ActiveWorkbook.SaveAs Filename:=Environ$("USERPROFILE") & "\Desktop\SplitIRs\" & emplID & " " & Time & ".xlsx"
        Application.ActiveWorkbook.Close False
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Sheets saved successfully on your desktop."
End Sub

1 个答案:

答案 0 :(得分:2)

Dim rng As Range
For Each xWs In wb.Worksheets
    emplID = ""
    '/Search in the sheet and after first cell
    Set rng = xWs.Cells.Find(What:="EmplID:", After:=xWs.Cells(1, 1), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    '/ Did we find something?
    If Not rng Is Nothing Then
        emplID = rng.Value
        emplID = Right(emplID, 6)
        Sheets("Tracker").Range("A" & I) = emplID


        I = I + 1

        Time = Format(Now, "yyyy-mm-dd hh-mm-ss")
        xWs.Copy
        Application.ActiveWorkbook.SaveAs Filename:=Environ$("USERPROFILE") & "\Desktop\SplitIRs\" & emplID & " " & Time & ".xlsx"
        Application.ActiveWorkbook.Close False
    End If
    Next