Это было проще, чем я думал. Полагаю, мне просто нужно было найти подходящую музу. Это не относится непосредственно к поиску, когда существуют дубликаты, но в моем случае каждый поисковый термин был уникальным во всех листах, так что это сработало.
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