并希望.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
答案 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