【VBA案例001】实现VLOOKUP功能

VBA实现VLOOKUP函数功能

数据 VBA
姓名 年龄 姓名 年龄
潘全桂 24 荆琛泽
霍栋保 35 吉栋松
荆琛泽 24 百里刚晓
越伦信 25 农康雪
吉栋松 34 越伦信
桂真顺 27 霍栋保
百里刚晓 19 潘全桂
农康雪 33 桂真顺

直接附上VBA代码：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
'Option Explicit

Sub 单元格循环()
    Dim cel As Range
    Dim cel2 As Range
    Dim t As Double
    t = Timer
    [e6:e13] = ""
    For Each cel In Range("a6:a13")
        For Each cel2 In Range("d6:d13")
            If cel.Value = cel2.Value Then
                cel2.Offset(0, 1).Value = cel.Offset(0, 1).Value
                Exit For
            End If
        Next
    Next
    Debug.Print Format(Timer - t, "0.00000000000000s")
End Sub

Sub 数组循环()
    Dim ar, br
    Dim t As Double
    t = Timer
    [e6:e13] = ""
    ar = [a6:b13] 'range("a6:b13")
    br = [d6:e13]

    Dim i, j
    For i = 1 To UBound(ar)
        For j = 1 To UBound(ar)
            If ar(i, 1) = br(j, 1) Then
                br(j, 2) = ar(i, 2)
                Exit For
            End If
        Next j
    Next i

    [d6:e13] = br
    Debug.Print Format(Timer - t, "0.00000000000000s")
End Sub

Sub 字典循环()
    Dim d As Object, kw$
    Set d = CreateObject("Scripting.Dictionary")
    'd.CompareMode = vbTextCompare '不区分大小写
    Dim ar, br
    Dim t As Double
    t = Timer
    [e6:e13] = ""
    ar = [a6:b13] 'range("a6:b13")
    br = [d6:e13]

    Dim i, j
    For i = 1 To UBound(ar)
        d(ar(i, 1)) = ar(i, 2) 'KEY ITEM
    Next i

    For j = 1 To UBound(br)
        br(j, 2) = d(br(j, 1))
    Next j

    [d6:e13] = br
    Debug.Print Format(Timer - t, "0.00000000000000s")
End Sub

原始链接