excel 如何更改集合项的值

krugob8w  于 2023-03-04  发布在  其他
关注(0)|答案(7)|浏览(142)

使用这段代码(在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"

或者是这样的:(我知道这行不通)

Coll("String1") = "myString"
zu0ti5jz

zu0ti5jz1#

您还可以编写一个(public)函数来更新集合。

public function updateCollectionWithStringValue(coll as 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")

然后您就可以调用一个一行程序。

zysjyyx4

zysjyyx42#

不能使用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

这不是应该做的工作吗?

2skhul33

2skhul333#

下面是Coll("String1") = "myString"***可以***工作的解决方案。
当您将对象.Add到VBA集合中时,对象本身被添加,而不是它的值。这意味着您可以在对象位于集合中时更改对象的属性。我创建了一个类模块,它将单个变量 Package 在类对象中,并将.Value作为其默认属性。将此模块保存到.cls文件,然后在VBA编辑器中保存到File > Import File

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsValue"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Compare Database
Option Explicit
Private MyValue As Variant
Property Get Value() As Variant
    Attribute Value.VB_UserMemId = 0
    Value = MyValue
End Property
Property Let Value(v As Variant)
    Attribute Value.VB_UserMemId = 0
    MyValue = v
End Property

现在,这个版本的代码按您希望的方式工作:

Private Sub clsValue_test()
Dim Coll As New Collection
Dim myArr()
Dim v As Variant
myArr = Array("String1", "String2", "String3")
For Each v In myArr
    Coll.Add New clsValue, v
    Coll(v) = "NULL"
Next v
Coll("String1") = "myString"    ' it works!
For Each v In myArr
    Debug.Print v, ": "; Coll(v)
Next v
End Sub

生成结果:

String1       : myString
String2       : NULL
String3       : NULL
qmelpv7a

qmelpv7a4#

making a function that deletes the collection item by its key的变体,将其实现为VBA * 属性 *

Public Property Let CollectionValue(coll As Collection, key As String, value As String)
    On Error Resume Next
    coll.Remove key
    On Error GoTo 0
    coll.Add value, key
End Property

Public Property Get CollectionValue(coll As Collection, key As String) As String
    CollectionValue = coll(key)
End Property

并像这样使用

'Writing
CollectionValue(coll, "Date") = Now()

'Reading
Debug.Print(CollectionValue(coll, "Date"))

如果键不存在,则忽略它,它也可用于添加项

zzoitvuj

zzoitvuj5#

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

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
cbjzeqam

cbjzeqam6#

我刚刚遇到了同样的问题,一个想法,张贴我的解决方案在这里的任何人谁可能需要它。我的解决方案是使一个类名为 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

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

czq61nw1

czq61nw17#

Sub tcoll()
 Dim c As New Collection
 c.Add Array("1", 2, False)
 c.Add Array("2", 3, False)
 c.Add Array("1", 4, False)
 For Each ci In c:  Debug.Print ci(0), ci(1), ci(2): Next
 If 1 Then
  'ok
  For X = c.Count To 1 Step -1
   Select Case c(X)(0)
   Case "1"
    c.Add Array(c(X)(0), c(X)(1), 1), after:=X
    c.Remove X
   Case "2"
    c.Remove X
   End Select
  Next
 Else
  'Subscript out of range
  For X = 1 To c.Count
   Select Case c(X)(0)
   Case "1"
    c(X)(2) = 1 'no error but collection is not changed
   Case "2"
    c.Remove X
   End Select
  Next
 End If
 For Each ci In c:  Debug.Print ci(0), ci(1), ci(2): Next
 Set c = Nothing
End Sub

相关问题