Excel中单元格到字典的转换

我有一份工作表，数据在a列到D列

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

例如，如果我们有：

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

宏将生成一个包含两个键（Apple、Banana）的字典，一个数组作为Apple的值（“Red”、“Round”、“Yummy”），另一个数组作为Banana的值（“Yellow”、“Crescent”和“）。列A中没有可跳过的空格，因此宏可以停止使用列A中没有值的第一个单元格构建字典。如果在B、C或D列中有一个空单元格，则数组将用“”保留其位置

我希望以后使用该键访问此词典，并提取与该键相关的值，以使用不同的宏填充不同工作表上的单元格

提前谢谢

编辑：

谢谢大家的指点！我不确定从哪里开始，因为我对VBA语言还不熟悉

这就是我目前的处境。我有几个问题

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

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

字典中的数组 链接

示例

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

• 这里有一个适合你需要的例子。玩它，当你被卡住时再回来。有了代码，就更容易得到答案

代码

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

---

我能够用下面的代码解决这个问题。由于我不熟悉VBA，弄清楚dictionary对象的语法（以及我必须导入脚本库的事实），我决定使用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

---

到目前为止你试过什么？你在哪里遇到问题的？请在你的问题中包括这一点。这是否回答了你的问题？