Question

如何确定对象是否是VBA中集合的成员？

具体来说，我需要找出一个表定义是否是TableDefs集合的成员。

Answer 1

不够好吗？

Public Function Contains(col As Collection, key As Variant) As Boolean
Dim obj As Variant
On Error GoTo err
    Contains = True
    obj = col(key)
    Exit Function
err:

    Contains = False
End Function

Answer 2

不完全优雅，但我能找到的最好（也是最快）的解决方案是使用OnError。对于任何中型到大型集合，这将明显快于迭代。

Public Function InCollection(col As Collection, key As String) As Boolean
  Dim var As Variant
  Dim errNumber As Long

  InCollection = False
  Set var = Nothing

  Err.Clear
  On Error Resume Next
    var = col.Item(key)
    errNumber = CLng(Err.Number)
  On Error GoTo 0

  '5 is not in, 0 and 438 represent incollection
  If errNumber = 5 Then ' it is 5 if not in collection
    InCollection = False
  Else
    InCollection = True
  End If

End Function

Answer 3

您最好的选择是迭代收藏品的成员，看看是否符合您的要求。相信我，我必须多次这样做。

第二个解决方案（更糟糕的是）捕获“Item not in collection”错误，然后设置一个标志来说明该项目不存在。

Answer 4

这是一个老问题。我仔细审查了所有的答案和评论，测试了解决方案的性能。

我为我的环境提出了最快的选项，当集合包含对象和基元时，它不会失败。

Public Function ExistsInCollection(col As Collection, key As Variant) As Boolean
    On Error GoTo err
    ExistsInCollection = True
    IsObject(col.item(key))
    Exit Function
err:
    ExistsInCollection = False
End Function

此外，此解决方案不依赖于硬编码的错误值。因此参数col As Collection可以被其他一些集合类型变量替换，并且该函数仍然可以工作。例如，在我目前的项目中，我将其作为col As ListColumns。

Answer 5

我从上述建议中创建了这个解决方案，并混合了用于迭代集合的微软解决方案。

Public Function InCollection(col As Collection, Optional vItem, Optional vKey) As Boolean
On Error Resume Next

Dim vColItem As Variant

InCollection = False

If Not IsMissing(vKey) Then
    col.item vKey

    '5 if not in collection, it is 91 if no collection exists
    If Err.Number <> 5 And Err.Number <> 91 Then
        InCollection = True
    End If
ElseIf Not IsMissing(vItem) Then
    For Each vColItem In col
        If vColItem = vItem Then
            InCollection = True
            GoTo Exit_Proc
        End If
    Next vColItem
End If

Exit_Proc:
Exit Function
Err_Handle:
Resume Exit_Proc
End Function

Answer 6

您可以缩短建议的代码并概括意外错误。你走了：

Public Function InCollection(col As Collection, key As String) As Boolean

  On Error GoTo incol
  col.Item key

incol:
  InCollection = (Err.Number = 0)

End Function

Answer 7

在您的特定情况下（TableDefs）迭代集合并检查Name是一种很好的方法。这没关系，因为集合的密钥（Name）是集合中类的属性。

但是在VBA集合的一般情况下，密钥不一定是集合中对象的一部分（例如，您可能将集合用作字典，其中的密钥与该对象中的对象无关。采集）。在这种情况下，您别无选择，只能尝试访问该项并捕获错误。

Answer 8

我有一些编辑，最适合收藏：

Public Function Contains(col As collection, key As Variant) As Boolean
    Dim obj As Object
    On Error GoTo err
    Contains = True
    Set obj = col.Item(key)
    Exit Function
    
err:
    Contains = False
End Function

Answer 9

如果集合中的项目不是“对象”，而是“数组”，则需要进行一些额外的调整。除此之外它对我来说很好。

Public Function CheckExists(vntIndexKey As Variant) As Boolean
    On Error Resume Next
    Dim cObj As Object

    ' just get the object
    Set cObj = mCol(vntIndexKey)

    ' here's the key! Trap the Error Code
    ' when the error code is 5 then the Object is Not Exists
    CheckExists = (Err <> 5)

    ' just to clear the error
    If Err <> 0 Then Call Err.Clear
    Set cObj = Nothing
End Function

_{来源：http://coderstalk.blogspot.com/2007/09/visual-basic-programming-how-to-check.html}

Answer 10

此版本适用于基本类型和类（包括简短测试方法）

' TODO: change this to the name of your module
Private Const sMODULE As String = "MVbaUtils"

Public Function ExistsInCollection(oCollection As Collection, sKey As String) As Boolean
    Const scSOURCE As String = "ExistsInCollection"

    Dim lErrNumber As Long
    Dim sErrDescription As String

    lErrNumber = 0
    sErrDescription = "unknown error occurred"
    Err.Clear
    On Error Resume Next
        ' note: just access the item - no need to assign it to a dummy value
        ' and this would not be so easy, because we would need different
        ' code depending on the type of object
        ' e.g.
        '   Dim vItem as Variant
        '   If VarType(oCollection.Item(sKey)) = vbObject Then
        '       Set vItem = oCollection.Item(sKey)
        '   Else
        '       vItem = oCollection.Item(sKey)
        '   End If
        oCollection.Item sKey
        lErrNumber = CLng(Err.Number)
        sErrDescription = Err.Description
    On Error GoTo 0

    If lErrNumber = 5 Then ' 5 = not in collection
        ExistsInCollection = False
    ElseIf (lErrNumber = 0) Then
        ExistsInCollection = True
    Else
        ' Re-raise error
        Err.Raise lErrNumber, mscMODULE & ":" & scSOURCE, sErrDescription
    End If
End Function

Private Sub Test_ExistsInCollection()
    Dim asTest As New Collection

    Debug.Assert Not ExistsInCollection(asTest, "")
    Debug.Assert Not ExistsInCollection(asTest, "xx")

    asTest.Add "item1", "key1"
    asTest.Add "item2", "key2"
    asTest.Add New Collection, "key3"
    asTest.Add Nothing, "key4"
    Debug.Assert ExistsInCollection(asTest, "key1")
    Debug.Assert ExistsInCollection(asTest, "key2")
    Debug.Assert ExistsInCollection(asTest, "key3")
    Debug.Assert ExistsInCollection(asTest, "key4")
    Debug.Assert Not ExistsInCollection(asTest, "abcx")

    Debug.Print "ExistsInCollection is okay"
End Sub

Answer 11

对于未用于收集密钥的情况：

Public Function Contains(col As Collection, thisItem As Variant) As   Boolean

  Dim item As Variant

  Contains = False
  For Each item In col
    If item = thisItem Then
      Contains = True
      Exit Function
    End If
  Next
End Function

Answer 12

不是我的代码，但我认为它编写得非常好。它允许通过键和Object元素本身进行检查，并处理On Error方法和迭代所有Collection元素。

https://danwagner.co/how-to-check-if-a-collection-contains-an-object/

我不会复制完整的说明，因为它在链接页面上可用。如果页面最终在将来不可用，则复制解决方案本身。

我对代码的疑问是GoTo在第一个If块中的过度使用，但是很容易为任何人修复，所以我将保留原始代码。

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Kollection, the collection we would like to examine
'            : (Optional) Key, the Key we want to find in the collection
'            : (Optional) Item, the Item we want to find in the collection
'OUTPUT      : True if Key or Item is found, False if not
'SPECIAL CASE: If both Key and Item are missing, return False
Option Explicit
Public Function CollectionContains(Kollection As Collection, Optional Key As Variant, Optional Item As Variant) As Boolean
    Dim strKey As String
    Dim var As Variant

    'First, investigate assuming a Key was provided
    If Not IsMissing(Key) Then

        strKey = CStr(Key)

        'Handling errors is the strategy here
        On Error Resume Next
            CollectionContains = True
            var = Kollection(strKey) '<~ this is where our (potential) error will occur
            If Err.Number = 91 Then GoTo CheckForObject
            If Err.Number = 5 Then GoTo NotFound
        On Error GoTo 0
        Exit Function

CheckForObject:
        If IsObject(Kollection(strKey)) Then
            CollectionContains = True
            On Error GoTo 0
            Exit Function
        End If

NotFound:
        CollectionContains = False
        On Error GoTo 0
        Exit Function

    'If the Item was provided but the Key was not, then...
    ElseIf Not IsMissing(Item) Then

        CollectionContains = False '<~ assume that we will not find the item

        'We have to loop through the collection and check each item against the passed-in Item
        For Each var In Kollection
            If var = Item Then
                CollectionContains = True
                Exit Function
            End If
        Next var

    'Otherwise, no Key OR Item was provided, so we default to False
    Else
        CollectionContains = False
    End If

End Function

Answer 13

我使用此代码将数组转换为集合，然后又转换回数组以删除重复项，这些重复项是从此处的各种帖子中收集的（抱歉，由于使用不当而致谢）。

Function ArrayRemoveDups(MyArray As Variant) As Variant
Dim nFirst As Long, nLast As Long, i As Long
Dim item As Variant, outputArray() As Variant
Dim Coll As New Collection

'Get First and Last Array Positions
nFirst = LBound(MyArray)
nLast = UBound(MyArray)
ReDim arrTemp(nFirst To nLast)
i = nFirst
'convert to collection
For Each item In MyArray
    skipitem = False
    For Each key In Coll
        If key = item Then skipitem = True
    Next
    If skipitem = False Then Coll.Add (item)
Next item
'convert back to array
ReDim outputArray(0 To Coll.Count - 1)
For i = 1 To Coll.Count
    outputArray(i - 1) = Coll.item(i)
Next
ArrayRemoveDups = outputArray
End Function

Answer 14

我是这样做的，这是Vadims代码的变体，但对我来说更具可读性：

' Returns TRUE if item is already contained in collection, otherwise FALSE

Public Function Contains(col As Collection, item As String) As Boolean

    Dim i As Integer

    For i = 1 To col.Count

    If col.item(i) = item Then
        Contains = True
        Exit Function
    End If

    Next i

    Contains = False

End Function

Answer 15

我写了这段代码。我猜它可以帮助别人...

Public Function VerifyCollection()
    For i = 1 To 10 Step 1
       MyKey = "A"
       On Error GoTo KillError:
       Dispersao.Add 1, MyKey
       GoTo KeepInForLoop
KillError: 'If My collection already has the key A Then...
        count = Dispersao(MyKey)
        Dispersao.Remove (MyKey)
        Dispersao.Add count + 1, MyKey 'Increase the amount in relationship with my Key
        count = Dispersao(MyKey) 'count = new amount
        On Error GoTo -1
KeepInForLoop:
    Next
End Function

确定对象是否是VBA中集合的成员

15 个答案: