如何用VBA实现vlookup的功能

Question

如图 我想用VBA实现下面vlookup()的功能原始数据比较多，想看看用VBA计算会不会快一点

Answer 1

答：如果编写一个自定义函数，可能速度会慢一点。如何是实现功能，可以利用字典对象来模拟实现，速度可能会快一点。以下是我写的2段代码，供参考。

Function MyVlookup(LookValue As Range, ArrRng As Range, Ofst As Integer)
    Dim RltRng As Range
    Dim AcLookValue As Range, AcArrRng As Range
    Set AcLookValue = LookValue.Cells(1, 1)
    Set AcArrRng = Intersect(ArrRng.Parent.UsedRange, ArrRng)
    On Error Resume Next
    Set RltRng = AcArrRng.Columns(1).Find(what:=AcLookValue, lookat:=xlPart)
    On Error GoTo 0
    If Not RltRng Is Nothing Then
        MyVlookup = RltRng.Offset(0, Ofst - 1)
    End If
End Function

Sub Demo()
    Dim Dic As Object
    Dim Cell As Range
    Set Dic = CreateObject("scripting.dictionary")
    For Each Cell In Range("G2:G12")
        Dic.Add Cell.Value, Cell.Offset(0, 1).Value
    Next

    For Each Cell In Range("D2:D12")
        If Dic.exists(Cell.Offset(0, -3).Value) Then
            Cell = Dic.Item(Cell.Offset(0, -3).Value)
        End If
    Next
End Sub

追问

我运行了
数据很多 然后 速度很慢 比用公式还慢很多

追答

用的第几段代码？

追问

第二段
第一段不太理解什么意思

追答

我重新改写了代码，用10000行数据做了测试对比，公式大概1秒，代码用了0.8秒多点。以下是新代码：

Sub Demo1()
    Dim Dic As Object
    Dim Arr() As String
    Dim i As Long

    Set Dic = CreateObject("scripting.dictionary")
    For i = 2 To 12
        Dic.Add Cells(i, 7).Value, Cells(i, 8).Value
    Next
    ReDim Arr(0 To 10)
    With Dic
        For i = 2 To 12
            If .exists(Cells(i, 1).Value) Then
                Arr(i - 2) = .Item(Cells(i, 1).Value)
            Else
                Arr(i - 2) = ""
            End If
        Next
    End With
    Range("D2").Resize(11, 1) = Application.Transpose(Arr)
End Sub