vba - 检查值是否存在于集合或数组中，如果不存在，则添加

Question

我想将项目列表添加到集合中并避免添加重复项。这是我在 A 列中的列表

Apple
Orange
Pear
Orange
Orange
Apple
Carrot

我只想添加

Apple 
Orange 
Pear 
Carrot

这是我想出的，它有效，但它并不漂亮。

dim coll as New Collection

ln = Cells(Rows.Count, 1).End(xlUp).Row

coll.Add (Cells(1, 1).Value)   'Add first item manually to get it started
For i = 1 To ln

    addItem = True    'Assume it's going to be added until proven otherwise

    For j = 1 To coll.Count    'Loop through the collection

        'If we ever find the item in the collection
        If InStr(1, Cells(i, 1), coll(j), vbTextCompare) > 0 Then                     

            addItem = False     'set this bool false

        End If

    Next j

    If addItem = True Then   'It never got set to false, so add it

        coll.Add (Cells(i, "A").Value)

    End If

Next i

有没有更简单的方法来做到这一点？最好是像

If Not coll.Contains(someValue) Then
    coll.Add (someValue)
End If

标签： vbaexcel

Answer 1

我强烈推荐使用字典，因为它们有很多集合没有的特性，包括Exists函数。

话虽如此，很容易创建一个函数，首先检查集合中是否存在值，然后创建另一个函数，如果它不存在，则只会添加一个值。

检查值是否存在

要查看它是否已经存在，只需使用一个简单的 for 循环。如果值存在，则返回 true 并退出函数。

' Check to see if a value is in a collection.
' Functional approcah to mimic dicitonary `exists` method.
Public Function CollectionValueExists(ByRef target As Collection, value As Variant) As Boolean
    Dim index As Long
    For index = 1 To target.Count
        If target(index) = value Then
            CollectionValueExists = True
            Exit For
        End If
    Next index
End Function

添加唯一值

使用新函数CollectionValueExists就像一个if条件语句一样简单，看看是否应该添加它。

为了使这更加动态，您还可以使用 aParamArray来允许一次调用添加多个值。只需循环每个值并查看是否需要添加它。这不适用于您的示例，但可灵活用于其他用途。

' Adds unique values to a collection.
' @note this mutates the origianal collection.
Public Function CollectionAddUnique(ByRef target As Collection, ParamArray values() As Variant) As Boolean
    Dim index As Long
    For index = LBound(values) To UBound(values)
        If Not CollectionValueExists(target, values(index)) Then
            CollectionAddUnique = True
            target.Add values(index)
        End If
    Next index
End Function

演示

把它们放在一起，你可以简单地循环你的范围并调用新函数。

Private Sub demoAddingUniqueValuesToCollection()
    Dim fruits As Collection
    Set fruits = New Collection
    
    Dim cell As Range
    For Each cell In Range("A1", Range("A" & Rows.Count).End(xlUp))
        CollectionAddUnique fruits, cell.value
    Next cell
End Sub