我有一些代码循环遍历工作簿中的一系列工作表，并尝试查找与另一个工作表中的值匹配。
Private Sub MatchData(NewMIARep As Worksheet, MaxRow As Long, wkbFinalized As Workbook)
Dim wksFinalized As Worksheet
Dim lCount As Long
Dim lFinMaxRow As Long
Dim DataRange As Variant
Dim SearchRange As Variant
Dim FoundRange As Range
Application.Calculation = xlCalculationManual
With NewMIARep
DataRange = .Range("J2:K" & MaxRow)
SearchRange = .Range("A2:A" & MaxRow)
For Each wksFinalized In wkbFinalized.Sheets
lFinMaxRow = GetMaxRow(wksFinalized)
If lFinMaxRow > 1 Then
For lCount = 1 To MaxRow - 1
If Len(DataRange(lCount, 1)) = 0 And Len(DataRange(lCount, 2)) = 0 Then
Set FoundRange = wksFinalized.Range("A2:A" & lFinMaxRow).Find(What:=SearchRange(lCount, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not FoundRange Is Nothing Then
DataRange(lCount, 1) = FoundRange.Offset(ColumnOffset:=12).Value
DataRange(lCount, 2) = FoundRange.Offset(ColumnOffset:=2).Value
Set FoundRange = Nothing
End If
End If
Next lCount
End If
Next wksFinalized
.Range("J2:K" & MaxRow).Value = DataRange
.Range("J2:J" & MaxRow).NumberFormat = "mm/dd/yyyy"
End With
Application.Calculation = xlCalculationAutomatic
因为这会遍历wkbFinalized中的每个工作表，并且每个工作表都有30,000-60,000个左右的记录，并且我在该循环中为我要搜索的每个项目循环另外5,000-6,000次，这往往会放慢速度（不是世界上最快的机器，但我没有选择）。
我知道我不能具体做到这一点，但我正在寻找能够像一样工作的功能
wkbFinalized.Find(...)
与
wkbFinalized.Sheets(n).Find(...)。
这样的功能存在吗？
OR 有没有办法在搜索之前以某种方式将所有工作表中的所有数据预加载到一个范围内，以便内部循环只运行一次？ （这会更高效还是更低效？）
答案 0 :(得分：1)
这比我想象的要容易。我想，我只需要找到合适的缪斯。当存在重复项时，这并不直接解决搜索问题，但对于我的情况，每个搜索项在所有工作表中都是唯一的，因此这确实有效。
Private Sub MatchData(NewMIARep As Worksheet, MaxRow As Long, wkbFinalized As Workbook)
Dim wksFinalized As Worksheet
Dim lCount As Long
Dim lFinMaxRow As Long
Dim DataRange As Variant
Dim SearchRange As Variant
Dim FoundRange As Range
Dim FindRange As Range
Dim colBill As New Collection
Dim colDate As New Collection
Application.Calculation = xlCalculationManual
With NewMIARep
DataRange = .Range("J2:K" & MaxRow)
SearchRange = .Range("A2:A" & MaxRow)
For Each wksFinalized In wkbFinalized.Sheets
lFinMaxRow = GetMaxRow(wksFinalized)
If lFinMaxRow > 1 Then
Set FindRange = wksFinalized.Range("A2:M" & lFinMaxRow)
For lCount = 1 To lFinMaxRow - 1
' Keep one collection per item to pull from in search.
' This can be expanded to one collection for each column you want to search.
' I chose to use the direct value, but I suppose you could also grab the column(/number) or row number,
' or anything else about the cell found to use as a reference instead.
' Do this for all sheets BEFORE doing the lookups to avoid extra looping.
If Not InCollection(colBill, FindRange(lCount, 1).value) Then
colBill.Add FindRange(lCount, 3).value, FindRange(lCount, 1).value
colDate.Add FindRange(lCount, 13).value, FindRange(lCount, 1).value
End If
Next lCount
End If
Next wksFinalized
For lCount = 1 To MaxRow - 1
If Len(DataRange(lCount, 1)) = 0 And Len(DataRange(lCount, 2)) = 0 Then
If InCollection(colBill, CStr(SearchRange(lCount, 1))) Then
' For each search term, if we have a match in our previously created collections,
' then it exists somewhere in the source workbook, but we don't care on which sheet it resides.
' Simply pull the value from each collection that matches the key of the search term.
DataRange(lCount, 1) = colDate.item(CStr(SearchRange(lCount, 1)))
DataRange(lCount, 2) = colBill.item(CStr(SearchRange(lCount, 1)))
End If
End If
Next lCount
.Range("J2:K" & MaxRow).value = DataRange
.Range("J2:J" & MaxRow).NumberFormat = "mm/dd/yyyy"
End With
Application.Calculation = xlCalculationAutomatic
End Sub
'The InCollection function was pulled from some other source online.
'It is not my own creation.
Public Function InCollection(ColToCheck As Collection, KeyToCheck As String) As Boolean
Dim vTemp As Variant
Dim errNumber As Long
InCollection = False
Set vTemp = Nothing
Err.Clear
On Error Resume Next
vTemp = ColToCheck.item(KeyToCheck)
InCollection = (CLng(Err.Number) <> 5)
On Error GoTo 0 '5 is not in, 0 and 438 represent incollection
Err.Clear
Set vTemp = Nothing
End Function
这比原始版本的运行时间短得多。
以上与上述相同，但改为使用Scripting.Dictionary个对象，无需使用第二个函数（InCollection）：
Private Sub MatchData(NewMIARep As Worksheet, MaxRow As Long, wkbFinalized As Workbook)
Dim wksFinalized As Worksheet
Dim lCount As Long
Dim lFinMaxRow As Long
Dim DataRange As Variant
Dim SearchRange As Variant
Dim FoundRange As Range
Dim FindRange As Range
Dim dictBill As Object
Dim dictDate As Object
Application.Calculation = xlCalculationManual
Set dictBill = CreateObject("Scripting.Dictionary")
Set dictDate = CreateObject("Scripting.Dictionary")
With NewMIARep
DataRange = .Range("J2:K" & MaxRow)
SearchRange = .Range("A2:A" & MaxRow)
For Each wksFinalized In wkbFinalized.Sheets
lFinMaxRow = GetMaxRow(wksFinalized)
If lFinMaxRow > 1 Then
Set FindRange = wksFinalized.Range("A2:M" & lFinMaxRow)
For lCount = 1 To lFinMaxRow - 1
' Keep one collection per item to pull from in search.
' This can be expanded to one collection for each column you want to search.
' I chose to use the direct value, but I suppose you could also grab the column(/number) or row number,
' or anything else about the cell found to use as a reference instead.
' Do this for all sheets BEFORE doing the lookups to avoid extra looping.
If Not dictBill.Exists(FindRange(lCount, 1).Value) Then
dictBill.Add FindRange(lCount, 1).Value, FindRange(lCount, 3).Value
dictDate.Add FindRange(lCount, 1).Value, FindRange(lCount, 13).Value
End If
Next lCount
End If
Next wksFinalized
For lCount = 1 To MaxRow - 1
If Len(DataRange(lCount, 1)) = 0 And Len(DataRange(lCount, 2)) = 0 Then
If Not dictBill.Exists(CStr(SearchRange(lCount, 1))) Then
' For each search term, if we have a match in our previously created collections,
' then it exists somewhere in the source workbook, but we don't care on which sheet it resides.
' Simply pull the value from each collection that matches the key of the search term.
DataRange(lCount, 1) = dictDate.Item(CStr(SearchRange(lCount, 1)))
DataRange(lCount, 2) = dictBill.Item(CStr(SearchRange(lCount, 1)))
End If
End If
Next lCount
.Range("J2:K" & MaxRow).Value = DataRange
.Range("J2:J" & MaxRow).NumberFormat = "mm/dd/yyyy"
End With
Application.Calculation = xlCalculationAutomatic
End Sub