SUB 代替VLOOKUP()
方法一:
Dim d, ar, br, cr, wb As Workbook
Set d = CreateObject("Scripting.Dictionary")
br = Worksheets("Sheet1").[A1].CurrentRegion '需要配置的数据表
ar = Worksheets("R").[A1].CurrentRegion '目标表
ReDim CRR(1 To UBound(br) - 1, 1 To 1) '配置表的循环列数
For I = 2 To UBound(ar) '从目标表需要关联的字段
d(ar(I, 4)) = ar(I, 6)
Next
For I = 2 To UBound(br)
CRR(I - 1, 1) = d(br(I, 4)) '将CRR写到BRR表中
Next
Worksheets("Sheet1").Range("EJ2").Resize(UBound(br), 1) = CRR '匹配
方法二:
Dim arr, d As Object, CRR '
Set d = CreateObject("scripting.dictionary")
arr = Worksheets("基础信息表").[a1].CurrentRegion
brr = Worksheets("统计结果").[a1].CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 1)) = arr(i, 6)
Next
ReDim CRR(2 To UBound(brr), 1 To 1) '匹配目标表内容
For J = 2 To UBound(brr)
CRR(J, 1) = d(brr(J, 2))'''在字典里查找BRR值并返回相应值
Next
Worksheets("统计结果").[C2].Resize(UBound(CRR) - 1, 1) = CRR
Set d = Nothing
方法三:多列
Dim arr, d As Object, CRR '数组brr用来存放求和数据 '创建字典
Set d = CreateObject("scripting.dictionary") '数组赋值
arr = Worksheets("基础信息表").[a1].CurrentRegion '重置数组brr大小
brr = Worksheets("统计结果").[a1].CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 1)) = arr(i, 6) & "," & arr(i, 7)
Next
ReDim CRR(2 To UBound(brr), 1 To 1)
ReDim DRR(2 To UBound(brr), 1 To 1)
For J = 2 To UBound(brr)
If d(brr(J, 2)) <> "" Then
CRR(J, 1) = Split(d(brr(J, 2)), ",")(0) '在BRR里查找到此名,并返回对应值
DRR(J, 1) = Split(d(brr(J, 2)), ",")(1)
Else
CRR(J, 1) = ""
DRR(J, 1) = ""
End If
Next
Worksheets("统计结果").[C2].Resize(UBound(CRR) - 1, 1) = CRR
Worksheets("统计结果").[D2].Resize(UBound(CRR) - 1, 1) = DRR
Set d = Nothing
END SUB