EXCEL宏:用字典代替Vlookup

| |
[不指定 2020/06/18 06:18 | by 吕进 ]
120x120
Vlookup,在vba中一般用Application.Vlookup来实现,但总归要通过循环完成,如有不匹配的还报错,感觉效率不高。这里直接上几个用字典替代vlookup的方法。
方法一(经测试,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
方式二(以下转自网络):
Sub VLOOKUP_02()
    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 '匹配
End Sub

方式三:
Sub VLOOKUP_03()
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
End Sub

方式四(多列匹配):
Sub VLOOKUP_04()
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

  • 中查看更多 EXCEL宏:用字典代替Vlookup 相关内容
  • 中查看更多 EXCEL宏:用字典代替Vlookup 相关内容
  • 中查看更多 EXCEL宏:用字典代替Vlookup 相关内容
  • 中查看更多 EXCEL宏:用字典代替Vlookup 相关内容
  • Tags: , , , , ,
    互联故事 » 码到功成 | 评论(0) | 引用(0) | 阅读(1376)

    表情
    emotemotemotemotemot
    emotemotemotemotemot
    emotemotemotemotemot
    emotemotemotemotemot
    emotemotemotemotemot
    打开HTML
    打开UBB
    打开表情
    隐藏
    记住我
    昵称   密码   游客无需密码
    网址   电邮   [注册]