2020/06/18 06:18 | by
Vlookup，在vba中一般用Application.Vlookup来实现，但总归要通过循环完成，如有不匹配的还报错，感觉效率不高。这里直接上几个用字典替代vlookup的方法。
方法一(经测试，3000行数据匹配，只需0.0156秒)：
方法一(经测试，3000行数据匹配，只需0.0156秒)：
Sub VLOOKUP_01()
Dim t As Date
t = Timer
Application.ScreenUpdating = False
Sheets("DD").Range("AE2:AF10000").Clear
Set ddcl = Sheets("数据源")
Set dd = Sheets("目标表")
Dim data, temp, arr, brr
Dim d, v
Dim i&, k&
Set d = CreateObject("scripting.dictionary")
Set v = CreateObject("scripting.dictionary")
data = ddcl.[a2].CurrentRegion '被索引的数据表，也可以用具体的区域
'data = ddcl.Range("A1:D65536")
For i = 2 To UBound(data)
d(data(i, 1) & "") = data(i, 3) '被取值所在列，如果只匹配一列，就不需v字典了
v(data(i, 1) & "") = data(i, 4) '被取值所在列
Next
ddm = dd.Range("A65536").End(xlUp).Row
temp = dd.Range("k1:k" & ddm) '索引参照列，注意必须是第一行开始
ReDim arr(2 To UBound(temp), 1 To 1)
ReDim brr(2 To UBound(temp), 1 To 1)
For k = 2 To UBound(temp)
arr(k, 1) = d(temp(k, 1))
brr(k, 1) = v(temp(k, 1))
Next
dd.[AE2].Resize(UBound(arr) - 1, 1) = arr
dd.[AF2].Resize(UBound(brr) - 1, 1) = brr
Set d = Nothing
MsgBox "运行" & Format((Timer - t), "0.0000") & "秒"
End Sub
注意：目标表中的索引参照范围，必须从表的第一行开始，或者用dd.[K1].CurrentRegion
Dim t As Date
t = Timer
Application.ScreenUpdating = False
Sheets("DD").Range("AE2:AF10000").Clear
Set ddcl = Sheets("数据源")
Set dd = Sheets("目标表")
Dim data, temp, arr, brr
Dim d, v
Dim i&, k&
Set d = CreateObject("scripting.dictionary")
Set v = CreateObject("scripting.dictionary")
data = ddcl.[a2].CurrentRegion '被索引的数据表，也可以用具体的区域
'data = ddcl.Range("A1:D65536")
For i = 2 To UBound(data)
d(data(i, 1) & "") = data(i, 3) '被取值所在列，如果只匹配一列，就不需v字典了
v(data(i, 1) & "") = data(i, 4) '被取值所在列
Next
ddm = dd.Range("A65536").End(xlUp).Row
temp = dd.Range("k1:k" & ddm) '索引参照列，注意必须是第一行开始
ReDim arr(2 To UBound(temp), 1 To 1)
ReDim brr(2 To UBound(temp), 1 To 1)
For k = 2 To UBound(temp)
arr(k, 1) = d(temp(k, 1))
brr(k, 1) = v(temp(k, 1))
Next
dd.[AE2].Resize(UBound(arr) - 1, 1) = arr
dd.[AF2].Resize(UBound(brr) - 1, 1) = brr
Set d = Nothing
MsgBox "运行" & Format((Timer - t), "0.0000") & "秒"
End Sub
