更改字典中集合中项目的值

pau*_*aul 4 collections excel vba dictionary

我正在尝试创建一个字典,其中包含每个键的集合。这样做的原因是我想稍后从同一个键检索多个值。在此示例中,我想要获得唯一键的总值 (val) 以及出现次数 (n):

sub update()
Dim dict As Dictionary
Dim coll As Collection
Set dict = New Dictionary
Set coll = New Collection

coll.Add 100, "val"
coll.Add 3, "n"
dict.Add "coll", coll

Debug.Print dict.item("coll")("val")
Debug.Print dict.item("coll")("n")
Run Code Online (Sandbox Code Playgroud)

到目前为止,这工作正常,当我尝试更新集合中的值时会出现问题(对象不支持此功能):

dict.item("coll")("val") = dict.item("coll")("val") + 100
Run Code Online (Sandbox Code Playgroud)

我尝试过的:

如果我使用数组而不是集合,则不会出现错误,但值不会改变。仅当我将集合读出到变量、更改值、创建新集合、从字典中删除旧集合并添加新集合时,它才有效。

有什么办法可以像我上面的方法一样在一行中做到这一点吗?我也很高兴能找到该任务的替代解决方案。

mie*_*elk 5

一旦将项目添加到集合中,您就无法轻易更改它。这样的表达:

coll("n") = 5
Run Code Online (Sandbox Code Playgroud)

将导致运行时错误 '424': Object required

您可以通过下面的简单示例自行检查:

Sub testCol()
    Dim col As New VBA.Collection
    Call col.Add(1, "a")

    col("a") = 2  '<-- this line will cause Run-time error '424'

End Sub
Run Code Online (Sandbox Code Playgroud)

更改分配给给定集合中指定键的值的唯一方法是删除该值并添加具有相同键的另一个值。

下面是如何将分配给带有键 [ a ] 的集合的值从 1更改为 2 的简单示例:

Sub testCol()
    Dim col As New VBA.Collection
    With col
        Call .Add(1, "a")
        Call .Remove("a")
        Call .Add(2, "a")
    End With
End Sub
Run Code Online (Sandbox Code Playgroud)

下面是修改后的代码,以便您可以更改分配给集合中给定键的值:

Sub update()
    Dim dict As Dictionary
    Dim coll As Collection
    Set dict = New Dictionary
    Set coll = New Collection

    coll.Add 100, "val"
    coll.Add 3, "n"
    dict.Add "coll", coll

    Debug.Print dict.Item("coll")("val")
    Debug.Print dict.Item("coll")("n")
    'This works fine so far, the problem occurs when I try to update the value in the collection (object doesn't support this):

    Dim newValue As Variant
    With dict.Item("coll")
        newValue = .Item("val") + 100
        On Error Resume Next '<---- [On Error Resume Next] to avoid error if there is no such key in this collection yet.
        Call .Remove("val")
        On Error GoTo 0
        Call .Add(newValue, "val")
    End With

End Sub
Run Code Online (Sandbox Code Playgroud)