在 Excel 中将单元格转换为字典

Question

我有一个工作表，其中包含 A 到 D 列中的数据。

我正在寻找一种方便的方法来获取这些列并转换为字典，其中 A 列中的单元格是键，B、C、D 列形成一个数组，然后是值。

例如，如果我们有：

      A       B        C        D
1   Apple    Red     Round    Yummy
2   Banana  Yellow  Crescent  

宏将生成一个字典，其中包含两个键（Apple、Banana）和一个数组作为苹果的值（“Red”、“Round”、“Yummy”），一个数组作为香蕉的值（“黄色”、“新月”、“”）。 A 列中不会有空格被跳过，因此宏可以停止使用 A 列中没有值的第一个单元格构建字典。如果 B、C 或 D 列中有一个空单元格，则数组将用 "" 保存它的位置。

我希望稍后使用该键访问该字典并提取与该键关联的值以使用不同的宏填充不同工作表上的单元格。

提前致谢。

编辑：

感谢大家的指点！因为我是 VBA 语言的新手，所以我不确定从哪里开始。

这就是我目前所处的位置。我有几个问题。

1. 根据调试器，存储在 info 数组中的各种变量的值为 ""

2. 最后三行导致类型不匹配（运行时 13）错误。

    'Filling in Facility values from dictionary
    'Set up variables to capture data from contact table
    Dim dict As Dictionary
    Dim r As Integer
    Dim facilityID As String
    Dim facilityName As String
    Dim nameOnForm As String
    Dim contact As String
    Dim phone As String
    Dim fax As String
    Dim copies As Integer
    Dim info As Collection
    
    
    'Create the dictionary
    Set dict = New Dictionary
    Set info = New Collection
    
    'Initialize additional variables to aid iteration through table
    copies = 0
    r = 2 'First row contains header, so start at row 2
    
    facilityID = Worksheets("Contact List").Cells(r, 1).Value
    facilityName = Worksheets("Contact List").Cells(r, 2).Value
    nameOnForm = Worksheets("Contact List").Cells(r, 3).Value
    contact = Worksheets("Contact List").Cells(r, 4).Value
    phone = Worksheets("Contact List").Cells(r, 5).Value
    fax = Worksheets("Contact List").Cells(r, 6).Value
    
    
   

    'keep processing data until we run out of facilityIDs
    While Len(nameOnForm) > 0
        
        'If entry already in dict (unusual), then increment copy count
        If dict.Exists(nameOnForm) Then
            copies = copies + 1
            MsgBox "You have more than one facility with the same name!"
            
        'If not already in dict
        Else
            'First build the array object that will become the value
            info.Add facilityID
            info.Add nameOnForm
            info.Add contact
            info.Add phone
            info.Add fax
            
            'Add the key value pair to the dictionary
            dict.Add facilityName, info
        End If
        
        'increment the row we are looking at
        r = r + 1
        
        'update references accordingly
        facilityID = Worksheets("Contact List").Cells(r, 1).Value
        facilityName = Worksheets("Contact List").Cells(r, 2).Value
        nameOnForm = Worksheets("Contact List").Cells(r, 3).Value
        contact = Worksheets("Contact List").Cells(r, 4).Value
        phone = Worksheets("Contact List").Cells(r, 5).Value
        fax = Worksheets("Contact List").Cells(r, 6).Value
    
    Wend
    
    Worksheets("CRA Form").Range("D12").Value = dict(facilityName)(2) 'Contact
    Worksheets("CRA Form").Range("D14").Value = dict(facilityName)(3) 'Phone
    Worksheets("CRA Form").Range("C16").Value = dict(facilityName)(4) 'Fax

Answer 1

我能够使用以下代码解决该问题。由于我不熟悉 VBA，因此要弄清楚字典对象的语法（以及我必须导入脚本库的事实），我决定使用 2D 数组会简单得多。结果证明它的代码少了很多（尽管它仍然可以被压缩），而且更容易阅读。我要感谢大家的帮助，非常感谢！

干杯。

'create2DArray
Dim myValues2Array() As Variant
    
'declare variables to hold loop counters used to iterate through the individual values i
Dim rowCounter As Long
Dim columnCounter As Long
    
    
'assign values to 2DArray
myValues2Array = ThisWorkbook.Worksheets("Contact List").range("C2:F153").Value
    
For rowCounter = LBound(myValues2Array, 1) To UBound(myValues2Array, 1)
    
    'loop through each value in second array dimension (column)
    For columnCounter = LBound(myValues2Array, 2) To UBound(myValues2Array, 2)
        
        If CStr(myValues2Array(rowCounter, columnCounter)) = CStr(Worksheets("Template").range("B2").Value) Then
                
            Worksheets("CRA Form").range("D12").Value = CStr(myValues2Array(rowCounter, columnCounter + 1)) 'Contact
            Worksheets("CRA Form").range("D14").Value = CStr(myValues2Array(rowCounter, columnCounter + 2)) 'Phone
            Worksheets("CRA Form").range("C16").Value = CStr(myValues2Array(rowCounter, columnCounter + 3)) 'Fax
                
            MsgBox myValues2Array(rowCounter, columnCounter) & "'s info was filled in"
            
        End If
            
    Next columnCounter
        
Next rowCounter

Answer 2

字典中的数组

链接

• Microsoft Docs
• Excel Macro Mastery
• VBA for Smarties

示例

• 这是一个应该满足您需求的示例。玩它，当你卡住时回来。拥有代码可以更轻松地获得血统答案。

守则

Option Explicit

Sub TESTgetDictKeyFirst()
    
    Dim rng As Range
    Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
    
    Dim dict As Object: Set dict = getDictKeyFirst(rng)
    
    Debug.Print "Keys:" & vbLf & Join(dict.Keys, vbLf)
    
    Debug.Print "Values:"
    Dim Key As Variant
    For Each Key In dict.Keys
        Debug.Print Join(dict(Key), ",")
    Next Key

End Sub

Function getDictKeyFirst( _
    rng As Range) _
As Object
    Dim Data As Variant: Data = rng.Value
    Dim cCount As Long: cCount = UBound(Data, 2)
    Dim cItem As Variant: ReDim cItem(0 To cCount - 2)
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim i As Long
    Dim j As Long
    For i = 1 To UBound(Data, 1)
        For j = 2 To cCount
            cItem(j - 2) = Data(i, j)
        Next j
        dict(Data(i, 1)) = cItem
    Next i
    Set getDictKeyFirst = dict
End Function