Vba 如何更改集合项的值_Vba_Excel_Collections

Vba 如何更改集合项的值

vba excel collections

Vba 如何更改集合项的值,vba,excel,collections,Vba,Excel,Collections,使用此代码（在excel vba中），我根据数组向集合中添加了许多项。我使用数组的值作为键，使用字符串“NULL”作为添加的每个项的值 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

使用此代码（在excel vba中），我根据数组向集合中添加了许多项。
我使用数组的值作为键，使用字符串“NULL”作为添加的每个项的值

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"

或者有类似的事情：（我知道那不管用）

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

public function updateCollectionWithStringValue（coll作为集合，key作为字符串，value作为字符串）作为集合
coll.remove键
coll.add value，键
设置updateCollectionWithStringValue=coll
端函数

您可以通过以下方式调用此函数：

set coll=updateCollectionWithStringValue（coll，“String1”、“myString”）

那么您就有一个要调用的一行程序。

您不能使用

Before

参数来满足这个要求吗

例如：

Option Explicit

Sub TestProject()
    Dim myStrings As New Collection

    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 myStrings
    ' Or with the "Call" keyword: Call PrintCollectionContent(myStrings)
    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 myStrings
    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 myStrings
    Debug.Print "--- End Collection content after removal of the old content ---"

End Sub

Private Sub PrintCollectionContent(ByVal myColl As Variant)
    Dim i as Integer

    For i = 1 To myColl.Count()
        Debug.Print myColl.Item(i)
    Next i
End Sub

这不应该完成工作吗？

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

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

我只是遇到了同样的问题，我想把我的解决方案贴在这里，给任何可能需要它的人。我的解决方案是创建一个名为

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

作为一个额外的好处，您可以随时添加更多功能。

您是否尝试过使用

字典（来自脚本库）来代替？好吧，可以这么说，这是唯一的方法。杯子是正确的，用字典代替。如果你决定走这条路，你不能用收集来做。好的，还有一个问题：用字典代替收集有什么禁忌吗？是的。这对你有帮助。前几天我发现它：+1，因为它满足了OP的要求；但为此，您必须修复：1）前两行实际上只有一行，您留下了一个疯狂的剩余内容（Set myStringsRef=myStrings），既没有声明也没有必要；2） PrintCollectionContent（myStringsRef）-或者（myStrings）您的调用-需要该调用，或者在调用之前使用该调用，或者在调用之后删除括号。@MarceloScofano：您是对的，我使用了“疯狂的剩余内容”，因为当时我不知道何时使用call
（我现在只知道一个参数，你不必使用调用
，一开始非常混乱）。因此，我使用了“无用的”变量myStringsRef
。我在示例代码中也没有使用选项Explicit
，因此没有必要先声明该选项。作为当时的VBA新手，我现在知道如果没有选项Explicit
，我就不想再工作了，我现在也更清楚集合的工作方式ing…我编辑了我的答案。是的，我说疯了，因为一开始我发誓它符合代码，所以我声明了myStringsRef并做了一件事！只是在花了几分钟时间后，我决定去掉它，并且可以看到你的答案符合。谢谢你的回答，它让我相信我不必为我需要的东西使用字典。作为我的参考这里经过的每个人都不明白为什么Call（）和no（）是一种解释。键入：coll-ax Collection
必须是coll-as Collection
    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