如何用字典进行查找，实现相当于Vlookup的功能

Sub zz()
    Dim d, ar
    Set d = CreateObject("Scripting.Dictionary")
    ar = Sheet1.Range("A1").CurrentRegion
    For i = 2 To UBound(ar)
        d(ar(i, 3)) = Array(ar(i, 1), ar(i, 5))
    Next
    With Sheet2
        For Each k In d.keys
            .Cells(2 + n, 1) = k
            .Cells(2 + n, 2).Resize(1, 2) = d(k)
            n = n + 1
        Next
    End With
End Sub

 

Sub 据工号填写() 'bajifeng

'按工号顺序自动填写姓名、性别、工龄

    Dim lr1, lr2, i
    Dim arr, brr, crr()
    Dim d
    
    Sheets(1).Activate
    lr1 = [P65536].End(3).Row
    Set d = CreateObject("Scripting.Dictionary")
    arr = Sheets(1).Range("P1:CG" & lr1)
    For i = 2 To UBound(arr)
        d(arr(i, 29)) = Array(arr(i, 70), arr(i, 1), arr(i, 4))
    Next

    Sheets(2).Activate
    lr2 = Sheets(2).[AD65536].End(3).Row
    brr = Range(Cells(2, "AD"), Cells(lr2, "AD"))
    ReDim crr(1 To UBound(brr), 1 To 3)
    For i = 1 To UBound(brr)
        For Each k In d.keys
        If StrComp(brr(i, 1), k) = 0 Then
            crr(i, 1) = d(k)(0)
            crr(i, 2) = d(k)(1)
            crr(i, 3) = d(k)(2)
            End If
        Next
    Next
   
    [AH2].Resize(UBound(crr), 3).ClearContents
    [AH2].Resize(UBound(crr), 3) = crr
    
End Sub