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

我正在尝试创建一个字典，其中包含每个键的集合。原因是我想稍后从同一个键检索多个值。在本例中，我希望获得唯一键的总值（val）以及出现次数（n）：

到目前为止，这工作正常，当我尝试更新集合中的值时出现问题（对象不支持此操作）：

我尝试的是：

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

有什么方法可以像我上面的方法一样在一行中完成吗？

---

我也很乐意为该任务提供一个替代解决方案。

这可能并不优雅，但也许您可以编写一个sub来通过一个键更新集合：

Sub UpdateCol(ByRef C As Collection, k As Variant, v As Variant)
    On Error Resume Next
    C.Remove k
    On Error GoTo 0
    C.Add v, k
End Sub

这样使用：

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")

    UpdateCol dict.Item("coll"), "val", dict.Item("coll")("val") + 100
    Debug.Print dict.Item("coll")("val")
End Sub

输出如预期：

100 
3 
200 

---

将项目添加到集合中后，就无法如此轻松地对其进行更改。这种表达：

coll("n") = 5

将导致运行时错误“424”：需要对象

您可以在下面的简单示例中自己进行检查：

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

---

下面是您修改的代码，以允许您更改分配给集合中给定键的值：

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

子更新（）
字典
Dim coll As系列
Set dict=新字典
Set coll=新集合
coll.加上100，“val”
列加3，“n”
添加“coll”，coll
调试.打印目录项（“coll”）（“val”）
调试.打印目录项（“coll”）（“n”）
'到目前为止，这工作正常，当我尝试更新集合中的值时出现问题（对象不支持此操作）：
将新值作为变量
带有dict.Item（“coll”）
新值=.Item（“val”）+100
在错误恢复下一步“这里是一种使用用户定义对象（类）的方法。当然，你可以根据自己的问题来调整这一点

重命名类模块
cMyStuff
或其他有意义的名称

类模块
正则模
结果在即时窗口中

对于类似的问题，我使用了一个用户定义的对象（类），然后将该类对象添加到集合中。（UDO可以有多个属性；甚至可以将集合作为其属性之一）。键是一些唯一的字符串。您可能可以对Dictionary对象执行类似的操作，就像对集合一样，但我还没有使用它。谢谢您的建议！不幸的是，我还没有真正进入UDO，必须仔细看看它…非常感谢！这是一个非常清楚的解释。现在，我在一个单独的函数中进行更新，使主代码更具可读性。非常感谢！同上。。我必须先进入UDO，到目前为止从未使用过类模块。看起来有很多可能性。
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

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

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

Option Explicit
Private pTotalVal As Long
Private pCounter As Long

Public Property Get TotalVal() As Long
    TotalVal = pTotalVal
End Property
Public Property Let TotalVal(Value As Long)
    pTotalVal = Value
End Property

Public Property Get Counter() As Long
    Counter = pCounter
End Property
Public Property Let Counter(Value As Long)
    pCounter = Value
End Property

Option Explicit
Sub Update()
    Dim cMS As cMyStuff, dMS As Dictionary
    Dim I As Long

Set dMS = New Dictionary
For I = 1 To 3
    Set cMS = New cMyStuff
    With cMS
        .Counter = 1
        .TotalVal = I * 10
        If Not dMS.Exists("coll") Then
            dMS.Add "coll", cMS
        Else
            With dMS("coll")
                .TotalVal = .TotalVal + cMS.TotalVal
                .Counter = .Counter + 1
            End With
        End If
    End With
Next I

With dMS("coll")
    Debug.Print "Total Value", .TotalVal
    Debug.Print "Counter", .Counter
End With

End Sub

Total Value    60 
Counter        3