2023-10-23    2023-10-23    387 字  1 分钟

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

原始链接