VBA-利用字典代替VLOOKUP

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

你可能感兴趣的:(VBA)