excel - 如何使用 Excel VBA 宏将集合键值对合并为一组键值对？

Question

我有一个包含一些键值对的电子表格表，但在一个集合中，例如如下所示(键值的顺序不固定):

Key     Value     Key    Value    Key    Value
ABC     999       JKL     888     MNO    777
DEF     555       RST     666     XYZ    444
AAA     123                       NNN    333

我正在使用包含引用键的描述的映射表，并使用该键尝试在单独的表中打印描述旁边的值。
我的映射表如下所示:

SNo   Key    Description
1     ABC     Test1
2     JKL     Test2
3     MNO     Test3
4     DEF     Test4
5     RST     Test5
6     XYZ     Test6
7     AAA     Test7
8     BBB     Test8
9     CCC     Test9
...   ....    .....
14    NNN     Test14

在输出中，我试图在它们的 SNo 和描述旁边显示我的输入表中存在的那些键。这是我正在努力获得的预期输出。

SNo     Description     Value
 1      Test1           999
 2      Test2           888
 3      Test3           777
 4      Test4           555
 5      Test5           666
 6      Test6           444
 7      Test7           123
14      Test14          333

如何在 excel 宏中实现这一点？
我有一个函数，用于根据所选工作表中的单元格地址获取值，然后将其存储在变量中并将其传递给输出。但这是逐个单元的方法，执行时间太长。
这是我用来根据单元格地址获取值的示例函数，该单元格地址当前需要操作列和行索引以查找值并给我可以用来带来单元格值的单元格地址:

Function getAddress(ByVal colValue As String, ByVal rowValue As String) As Range
Dim row, col As Variant

With ActiveSheet
    row = Application.Match(rowValue, .Columns("B"), 0)  'To lookup for key in the mapping sheet but need to be changed based on the sheet the function is doing a lookup in
    col = Application.Match(colValue, .Rows(1), 0)
    
    If IsError(r) Then
        row = 0
        col = 0
    End If
    Set getAddress = .Cells(row, col)
    
End With
End Function

我确信存在更好的方法，但在过去的几个月里我正在探索 VBA 并在旅途中学习它。提前感谢任何帮助。

Answer 1

为此，您可以使用 Dictionary 对象:

Option Explicit

Sub MergeSets()
    ' set a reference to 'Microsoft Scripting Runtime' in Tools->References VBE menu
    Dim dict As New Dictionary
    Dim src As Variant, out As Variant
    Dim r As Long, c As Long, cnt As Long, key As String
    
    With ThisWorkbook.Worksheets(1)
        ' get the data from the first range (without header) into the src array in one read operation
        src = Intersect(.Range("A1").CurrentRegion, .Range("A1").CurrentRegion.Offset(1))
        ' make the dictionary
        For r = 1 To UBound(src, 1)
            For c = 1 To UBound(src, 2) Step 2
                key = Trim(CStr(src(r, c)))
                If Len(key) > 0 And Not dict.Exists(key) Then dict.Add key, src(r, c + 1)
            Next
        Next
        
        ' get the data from the second range (without header) into the src array in one read operation
        src = Intersect(.Range("H1").CurrentRegion, .Range("H1").CurrentRegion.Offset(1))
        ' prepare array for output
        ReDim out(1 To 3, 1 To UBound(src, 1))
        cnt = 0
        ' iterate the data from the second range
        For r = 1 To UBound(src, 1)
            key = Trim(CStr(src(r, 2)))
            ' match the data from the second range with the dictionary keys
            If Len(key) > 0 And dict.Exists(key) Then
                cnt = cnt + 1
                out(1, cnt) = src(r, 1) ' number
                out(2, cnt) = src(r, 3) ' Description
                out(3, cnt) = dict(key) ' value for key
            End If
        Next
        
        ' we can change only the last dimenshion of the array
        ReDim Preserve out(1 To 3, 1 To cnt)
        ' Transpose the out array to output
        out = WorksheetFunction.Transpose(out)
        
        ' output the result
        .Range("L2").Resize(cnt, 3).Value = out
    End With
End Sub

之前:

之后: