Question

VBA中是否可以将集合作为`Scripting.Dictionary＆＃39;值，然后在循环中，在找到特定键时向该集合添加新值？

类似的东西：

Dim test_dict As New Scripting.Dictionary

For Each cell In ActiveSheet.Range("S2:S13")
    test_dict(cell.value).Add (cell.offset(1,0).value)
Next cell

此外，我需要迎合密钥重复的事实。

例如在Python中，我可以将字典设置为将列表作为值，然后在每次迭代时附加到此列表：

dictionary= defaultdict(list)

for x in range(1,10):
    dictionary[x].append(x + 100)

Answer 1

我想我明白你要做什么。使用字典，您希望将键映射到项集合。如果我的理解是正确的，请检查以下代码，看看是否可以修改它以满足您的需要。我对它进行了测试，似乎有效。

Sub LoadThem()
    Dim coll As New Collection
    Dim rng As Range
    Dim cel As Range
    Dim oDict As Object

    Set oDict = CreateObject("Scripting.Dictionary")

    Set rng = Range("A1:A26")

    For Each cel In rng
        If oDict.exists(cel.Value) Then
            oDict(cel.Value).Add cel.Offset(, 1).Value
        Else
            Set coll = New Collection
            coll.Add cel.Offset(, 1).Value
            oDict.Add cel.Value, coll
        End If
    Next cel


    For Each okey In oDict.keys
        Debug.Print okey
        For Each elem In oDict(okey)
            Debug.Print "    " & elem
        Next elem
    Next okey
End Sub

Answer 2

喜欢以下内容？

Option Explicit

Public Sub GetValues()
    Const col_1 = "col1", col_2 = "col2", col_3 = "col3"

    Dim lists As Object: Set lists = CreateObject("Scripting.Dictionary")

    lists.Add col_1, New Collection
    lists.Add col_2, New Collection
    lists.Add col_3, New Collection

    Dim currentCell As Range
    For Each currentCell In ActiveSheet.Range("S2:S13")
        Select Case currentCell.Value
        Case col_1
            lists(col_1).Add currentCell.Offset(, 1).Value
        Case col_2
            lists(col_2).Add currentCell.Offset(, 1).Value
        Case col_3
            lists(col_3).Add currentCell.Offset(, 1).Value
        End Select
    Next

    Dim key As Variant, item As Long

    For Each key In lists
        For item = 1 To lists(key).Count
            Debug.Print lists(key)(item)
        Next
    Next
End Sub

数据：

如果您事先不知道密钥，请使用：

Option Explicit
Public Sub GetValues()
    Dim lists As Object: Set lists = CreateObject("Scripting.Dictionary")
    Dim currentCell As Range
    For Each currentCell In ActiveSheet.Range("S2:S13")
        If Not lists.exists(currentCell.Value) Then lists.Add currentCell.Value, New Collection
        lists(currentCell.Value).Add currentCell.Offset(, 1).Value
    Next

    Dim key As Variant, item As Long
    For Each key In lists
        For item = 1 To lists(key).Count
            Debug.Print lists(key)(item)
        Next
    Next
End Sub

VBA：添加到集合，这是一个字典值

2 个答案: