在 VBA 宏中使用字典的简单 VLOOKUP
Simple VLOOKUP using Dictionary in a VBA Macro
我希望通过 VBA 宏中的字典进行 vlookup。我在 Internet 上看到了一些示例,但它们大多非常具体,我希望获得有关更多 "bare bones" 代码的帮助。我将使用一个简单的例子来说明我想要实现的目标:
查找值是从 "Orders" 工作表上的单元格 B2 开始的动态范围内的每个单元格(底行不同)
Table 数组位于从单元格 E2 开始并延伸到 "Report" 工作表上的 L 列(底行不同)
列索引号为 8(L 列)
范围查找为假
我当前的代码如下:
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
我希望通过 VBA 宏中的字典进行 vlookup。我在 Internet 上看到了一些示例,但它们大多非常具体,我希望获得有关更多 "bare bones" 代码的帮助。我将使用一个简单的例子来说明我想要实现的目标:
查找值是从 "Orders" 工作表上的单元格 B2 开始的动态范围内的每个单元格(底行不同)
Table 数组位于从单元格 E2 开始并延伸到 "Report" 工作表上的 L 列(底行不同)
列索引号为 8(L 列)
范围查找为假
我当前的代码如下:
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