VBA模拟VLOOKUP

最新推荐文章于 2023-04-06 22:29:37 发布

Plum_sun

最新推荐文章于 2023-04-06 22:29:37 发布

阅读量1.5k

点赞数 3

分类专栏： Excle 文章标签： excle vba 自动化

本文链接：https://blog.csdn.net/xp4000/article/details/103494786

版权

Excle 专栏收录该内容

0 篇文章 0 订阅

订阅专栏

EXCLE中VLOOKUP频繁被使用，自动化报表中用VBA实现类似的功能更加方便。

功能实现如图：

Sub vlookupfunc()
    Dim i
    Dim arr, brr, crr()
    Dim Dic
    Dim Targettable, Sourcetbale

    Set Targettable = ThisWorkbook.Sheets("Sheet1") 'A表 目标配置表
    Set Sourcetbale = ThisWorkbook.Sheets("Sheet2") 'B表 源数据表
    Set Dic = CreateObject("Scripting.Dictionary")
    
    arr = Targettable.Range("A2:D" & Cells(Rows.Count, 1).End(xlUp).Row)
    brr = Sourcetbale.Range("A2:C" & Cells(Rows.Count, 1).End(xlUp).Row)
    
    For i = 1 To UBound(brr)
        Dic(brr(i, 1)) = Array(brr(i, 2), brr(i, 3))
    Next
    
    ReDim crr(1 To UBound(arr), 1 To 3)
    For i = 1 To UBound(arr)
        For Each k In Dic.keys
            If StrComp(brr(i, 1), k) = 0 Then
                crr(i, 1) = Dic(k)(0)
                crr(i, 2) = Dic(k)(1)
                End If
        Next
    Next

    [C2].Resize(UBound(crr), 3).ClearContents
    [C2].Resize(UBound(crr), 3) = crr
    
End Sub

END