在 VBA 宏中使用字典的简单 VLOOKUP

Simple VLOOKUP using Dictionary in a VBA Macro

我希望通过 VBA 宏中的字典进行 vlookup。我在 Internet 上看到了一些示例,但它们大多非常具体,我希望获得有关更多 "bare bones" 代码的帮助。我将使用一个简单的例子来说明我想要实现的目标:

我当前的代码如下:

Sub DictionaryVLookup()
Dim x, y, z(1 To 10)
Dim i As Long
Dim dict As Object
Dim LastRow As Long

LastRow = Worksheets("Report").Range("B" & Rows.Count).End(xlUp).Row


x = Sheets("Orders").Range("B2:B" & LastRow).Value
y = Sheets("Report").Range("E2:E" & LastRow).Value    'looks up to this range
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(x, 1)
    dict.Item(x(i, 1)) = x(i, 1)
Next i

For i = 1 To UBound(y, 1)
    If dict.exists(y(i, 1)) Then
        z(i) = y(i, 1)
    Else
        z(i) = "NA"
    End If
Next i
Worksheets("Orders").Range("Z2:Z" & LastRow).Value = Application.Transpose(z)    'this is where the values are placed

End Sub

我似乎遗漏了 "lookup" 部分,目前它运行时没有错误,并且简单地放置了查找 "found" 的值,但我不知道如何让 returned值被偏移(在这个例子中想要return列L)。

我还对这段代码做了一些 "Frankenstein" 工作 - 所以我不确定为什么会出现这种情况:

   Dim x, y, z(1 To 10)

(1 到 10) 我想我会想要充满活力。

这是我第一次尝试以这种方式使用字典 - 希望通过这个简单的示例获得基本的理解,然后我可以将其应用到更复杂的情况中。

我知道还有其他方法可以完成我所描述的事情,但希望专门了解字典。

在此先感谢您的帮助!

像这样:

Sub DictionaryVLookup()

    Dim x, x2, y, y2()
    Dim i As Long
    Dim dict As Object
    Dim LastRow As Long, shtOrders As Worksheet, shtReport As Worksheet

    Set shtOrders = Worksheets("Orders")
    Set shtReport = Worksheets("Report")
    Set dict = CreateObject("Scripting.Dictionary")

    'get the lookup dictionary from Report
    With shtReport
        LastRow = .Range("E" & Rows.Count).End(xlUp).Row
        x = .Range("E2:E" & LastRow).Value
        x2 = .Range("L2:L" & LastRow).Value
        For i = 1 To UBound(x, 1)
            dict.Item(x(i, 1)) = x2(i, 1)
        Next i
    End With

    'map the values
    With shtOrders
        LastRow = .Range("B" & Rows.Count).End(xlUp).Row
        y = .Range("B2:B" & LastRow).Value    'looks up to this range
        ReDim y2(1 To UBound(y, 1), 1 To 1)   '<< size the output array
        For i = 1 To UBound(y, 1)
            If dict.exists(y(i, 1)) Then
                y2(i, 1) = dict(y(i, 1))
            Else
                y2(i, 1) = "NA"
            End If
        Next i
        .Range("Z2:Z" & LastRow).Value = y2  '<< place the output on the sheet
    End With

End Sub

广义的@Tim Williams 优秀示例,在主子中没有硬编码范围以帮助关注用户。

'In sheet Phones lookup col F  at LogFileSh sheet col CE,CF and return 
'the results in col D sheet Phones. Row of F+D is 2 and row CE+CF is 2.

Sub RunDictionaryVLookup()
Call GeneralDictionaryVLookup(Phones, LogFileSh, "F", "CE", "CF", "D", 2, 2)
End Sub


Sub GeneralDictionaryVLookup(ByVal shtResault As Worksheet, ByVal shtsource As Worksheet, _
ByVal colLOOKUP As String, ByVal colDicLookup As String, ByVal colDicResault As String, ByVal colRESULT As String, _
ByVal rowSource As Long, ByVal rowResult As Long)
    Dim x As Variant, x2 As Variant, y As Variant, y2() As Variant
    Dim i As Long
    Dim dict As Object
    Dim LastRow As Long

    Set dict = CreateObject("Scripting.Dictionary")

    'get the lookup dictionary 
    With shtsource
        LastRow = .Range(colDicLookup & Rows.Count).End(xlUp).row
        x = .Range(colDicLookup & rowSource & ":" & colDicLookup & LastRow).Value
        x2 = .Range(colDicResault & rowSource & ":" & colDicResault & LastRow).Value
        For i = 1 To UBound(x, 1)
            dict.item(x(i, 1)) = x2(i, 1)
            Debug.Print dict.item(x(i, 1))
        Next i
    End With

    'map the values
    With shtResault
        LastRow = .Range(colLOOKUP & Rows.Count).End(xlUp).row
        y = .Range(colLOOKUP & rowResult & ":" & colLOOKUP & LastRow).Value  'looks up to this range
        ReDim y2(1 To UBound(y, 1), 1 To 1)   '<< size the output array
        For i = 1 To UBound(y, 1)
            If dict.Exists(y(i, 1)) Then
                y2(i, 1) = dict(y(i, 1))
            Else
                y2(i, 1) = "NA"
            End If
        Next i
        .Range(colRESULT & rowResult & ":" & colRESULT & LastRow).Value = y2   '<< place the output on the sheet
    End With
End Sub