代码之家 › 专栏 › 技术社区 › barciewicz

VBA:添加到字典值的集合中

excel-vba vba excel

barciewicz · 技术社区 · 6 年前

在VBA中,是否可以将集合设置为“scripting.dictionary”值,然后在循环中,在此集合中找到特定键时添加新值?

比如:

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中,我可以将字典设置为将list作为值,然后在每次迭代时附加到此列表:

dictionary= defaultdict(list)

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

2 回复 | 直到 6 年前

QHarr 6 年前

像下面这样?

选项显式

公共子GetValues()。
const col_1=“col1”,col_2=“col2”,col_3=“col3”

dim lists as object:set lists=createObject(“scripting.dictionary”)。

列表。添加列1,新集合
列表。添加列2,新集合
列表。添加第3列,新集合

将当前单元格变暗为范围
对于ActiveSheet.Range中的每个CurrentCell(“s2:s13”)。
选择case currentcell.value
案例栏1
列表(列1)。添加当前单元格。偏移量(,1)。值
案例列2
列表(列2)。添加当前单元格。偏移量(,1)。值
案例列3
列表(列3)。添加当前单元格。偏移量(,1)。值
结束选择
下一个

变暗键,项目长

对于列表中的每个键
对于item=1 to list(key).count
调试打印列表(键)(项)
下一个
下一个
末端接头
数据:



如果您事先不知道钥匙,请使用:

选项显式
公共子GetValues()。
dim lists as object:set lists=createObject(“scripting.dictionary”)。
将当前单元格变暗为范围
对于ActiveSheet.Range中的每个CurrentCell(“s2:s13”)。
如果不是lists.exists(currentcell.value),则lists.add currentcell.value,new collection
列表(currentcell.value)。添加currentcell.offset(,1)。value
下一个

变暗键,项目长
对于列表中的每个键
对于item=1 to list(key).count
调试打印列表(键)(项)
下一个
下一个
末端接头


数据:



如果您事先不知道钥匙,请使用:

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

basodre 6 年前

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

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