VBA：跨所有工作簿工作表使用类似于查找的function，无需循环
我有一些代码循环通过工作簿中的一系列工作表，并试图find一个匹配的另一个工作表中的值。
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每一个表单，每个表单有3万到6万个logging，并且我在这个循环内再次循环5,000-6,000次，这对我想要search的每个项目来说，这往往会减慢很多（不是世界上最快的机器，但我没有select的事情）。
我知道我不能做这个具体的，但我正在寻找一个function，将工作
wkbFinalized.Find(...)
与
wkbFinalized.Sheets(n).Find(...) 。
这样的function是否存在？
或者有没有办法在search之前将所有表单中的所有数据预加载到一个范围内，以便内部循环只运行一次？ （而且这个效率会更高或更低？）
这比我想象的要容易。 我想，我只需要find合适的缪斯。 当存在重复项时，这并不直接解决search问题，但对于我的情况，每个search项在所有工作表中都是唯一的，所以这确实起作用。
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
这比原来的版本运行的时间less得多。
这和上面的一样，但是使用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