Question

使用此代码（在excel-vba中）我根据数组向集合中添加了许多项目我使用数组的值作为键和字符串＆＃34; NULL＆＃34;作为每个项目的值。

Dim Coll As New collection
Dim myArr()

Set Coll = New collection
myArr() = Array("String1", "String2", "String3")

For i = LBound(myArr) To UBound(myArr)
    Coll.Add "NULL", myArr(i)
Next i

现在，如果我想更改项目的值，通过键识别它，我必须删除该项目然后添加具有相同键的项目，或者是否可以更改项目值？

以下是唯一的方法吗？

Coll.Remove "String1"
Coll.Add "myString", "String1"

或者是否有类似的东西:(我知道它不起作用）

Coll("String1") = "myString"

Answer 1

您还可以编写（公共）函数来更新集合。

public function updateCollectionWithStringValue(coll ax Collection, key as string, value as string) as collection
coll.remove key
coll.add value, key
set updateCollectionWithStringValue = coll
end function

您可以通过以下方式调用此功能：

set coll = updateCollectionWithStringValue(coll, "String1","myString")

然后你有一个班轮来调用。

Answer 2

您不能使用Before参数来满足此要求吗？

示例：

Sub TestProject()
    Dim myStrings As New Collection
    Set myStringsRef = myStrings

    myStrings.Add item:="Text 1"
    myStrings.Add item:="Text 2"
    myStrings.Add item:="Text 3"

    ' Print out the content of collection "myStrings"
    Debug.Print "--- Initial collection content ---"
    PrintCollectionContent (myStringsRef)
    Debug.Print "--- End Initial collection content ---"

    ' Now we want to change "Text 2" into "New Text"
    myStrings.Add item:="New Text", Before:=2 ' myStrings will now contain 4 items
    Debug.Print "--- Collection content after adding the new content ---"
    ' Print out the 'in-between' status of collection "myStrings" where we have
    ' both the new string and the string to be replaced still in.
    PrintCollectionContent (myStringsRef)
    Debug.Print "--- End Collection content after adding the new content ---"

    myStrings.Remove 3
    ' Print out the final status of collection "myStrings" where the obsolete 
    ' item is removed
    Debug.Print "--- Collection content after removal of the old content ---"
    PrintCollectionContent (myStringsRef)
    Debug.Print "--- End Collection content after removal of the old content ---"

End Sub

Private Sub PrintCollectionContent(ByVal myColl As Variant)
    For i = 1 To myColl.Count()
        Debug.Print myColl.item(i)
    Next i
End Sub

这不是做这份工作吗？

Answer 3

只需循环集合并将新值添加到新集合中...

function prep_new_collection(my_old_data as collection) as collection

dim col_data_prep as new collection

for i = 1 to my_old_data.count

if my_old_data(i)(0)= "whatever" then

  col_data_prep.add array("NULL", my_old_data(i)(1))

else

 col_data_prep.add array(my_old_data(i)(0), my_old_data(i)(1))

end if

next i

 set prep_new_collection = col_data_prep

end function

Answer 4

我刚刚遇到了同样的问题，我想在这里发布我的解决方案，供任何可能需要它的人使用。我的解决方案是创建一个名为 EnhancedCollection 具有更新功能。将此代码保存到名为 EnhancedCollection.cls 的文件中，然后导入到您的项目中。

    VERSION 1.0 CLASS
    BEGIN
      MultiUse = -1  'True
    END
    Attribute VB_Name = "EnhancedCollection"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    Option Explicit
    
    Private data As New Collection
       
    '=================================ADD
    
    If IsMissing(key) Then
        If IsMissing(before) Then
            If IsMissing(after) Then
                data.Add Value
            Else
                data.Add Value, , , after
            End If
        Else
            data.Add Value, , before
        End If
    ElseIf key = "TEMP_ITEM" Then
        Exit Sub
    Else
        If IsMissing(before) Then
            If IsMissing(after) Then
                data.Add Value, key
            Else
                data.Add Value, key, , after
            End If
        Else
            data.Add Value, key, before
        End If
    End If
End Sub
'=================================REMOVE

Sub Remove(key As Variant)
    data.Remove key
End Sub

    '=================================COUNT
    
    Function Count() As Integer
        Count = data.Count
    End Function
    '=================================ITEM
    
    Function Item(key As Variant) As Variant
    'This is the default Function of the class
    Attribute Item.VB_Description = "returns the item"
    Attribute Item.VB_UserMemId = 0
    On Error GoTo OnError
        If VarType(key) = vbString Or VarType(key) = vbInteger Then
            Item = data.Item(key)
        End If
        Exit Function
    OnError:
        Item = Null
    End Function
    '=================================Update
    
    Function Update(key As Variant, Value As Variant) As Variant
    On Error GoTo OnError
        If VarType(key) = vbString Or VarType(key) = vbInteger Then
            data.Add "", "TEMP_ITEM", , key
            data.Remove key
            data.Add Value, key, "TEMP_ITEM"
            data.Remove "TEMP_ITEM"
        End If
        Exit Function
    OnError:
        Update = Null
    End Function

另外一个好处是，您可以随时添加更多功能。

如何更改集合项的值

4 个答案: