[英]Vlookup Alternative using Dictionary
下面的代碼是 vlookup 的替代方法。
此查找然后根據兩個工作表的 A 列中的匹配值,即僅使用 1 個條件,將值從工作表“數據”的 D 列和 E 列復制到工作表“Master”的 D 列和 E 列。
有人可以幫助了解如何使下面的代碼查找和匹配 2 個條件,即查找和匹配兩張表的 A 列和 B 列嗎?
在此先感謝您的幫助...
Option Explicit
Sub VLookup_Alternative()
Dim rng As Range, j As Range, i, lRow As Long, Dict As Object, myArray As Variant
With Sheets("Data")
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
myArray = .Range("A1").Resize(lRow, 4)
Set Dict = CreateObject("scripting.dictionary")
Dict.CompareMode = vbTextCompare
For i = 2 To UBound(myArray, 1)
Dict(myArray(i, 1)) = i
Next
End With
With Sheets("Master")
Set rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
For Each j In rng
If Dict.exists(j.Value2) Then
j.Offset(, 3) = myArray(Dict(j.Value2), 3)
j.Offset(, 4) = myArray(Dict(j.Value2), 4)
End If
Next j
End With
End Sub
請測試下一個更新版本(匹配 A 和 B 列的串聯。使用數組根據字典項目比較主表中的值會更快一些:
Sub VLookup_Alternative_match2Cols()
Dim shD As Worksheet, shM As Worksheet, rng As Range, j As Range, i As Long
Dim lRow As Long, Dict As Object, myArray, arrM
Set shD = Sheets("Data")
Set shM = Sheets("Master")
With shD
lRow = .cells(.rows.count, 1).End(xlUp).row
myArray = .Range("A1").Resize(lRow, 5).Value2
Set Dict = CreateObject("scripting.dictionary")
Dict.CompareMode = vbTextCompare
For i = 2 To UBound(myArray, 1)
'to return the first occurrence in case of no unique keys:
If Not Dict.Exists(myArray(i, 1) & myArray(i, 2)) Then
Dict(myArray(i, 1) & myArray(i, 2)) = i
End If
Next
End With
With shM
Set rng = .Range(.Range("A2"), .Range("A" & rows.count).End(xlUp).Offset(0, 4))
arrM = rng.Value2 'place the range in an array for faster iteration
'and processing in memory
Dim lastArrRow As Long: lastArrRow = UBound(myArray)
For i = 1 To UBound(arrM)
If Dict.Exists(arrM(i, 1) & arrM(i, 2)) Then
arrM(i, 4) = myArray(Dict(arrM(i, 1) & arrM(i, 2)), 4)
arrM(i, 5) = myArray(Dict(arrM(i, 1) & arrM(i, 2)), 5)
Else 'return elements form the last row of myArray:
arrM(i, 4) = myArray(lastArrRow, 4)
arrM(i, 5) = myArray(lastArrRow, 5)
End If
Next i
End With
rng.value = arrM 'drop the processed array
MsgBox "Ready..."
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.