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

【问题标题】：Determining whether an object is a member of a collection in VBA确定对象是否是 VBA 中集合的成员
【发布时间】：2010-09-13 08:43:37
【问题描述】：

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

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

【问题讨论】：

标签： vba object ms-access collections

【解决方案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

【讨论】：

这似乎是这里介绍的所有解决方案中最简单的。我已经使用了它，并且效果很好。但是，我确实必须将 col 参数更改为 Variant 类型。
将近 6 年后，它仍然是一个完美可行的解决方案。我按原样使用它，没有任何问题。
这是一个很好的解决方案，只是有点傻，需要成千上万的人重新实现它。 VB/VBA 应该比这更高。
对我来说效果很好。
如果键的值是对象而不是原语，这不起作用 - 如果值是对象，您将收到分配错误（对象引用需要使用“Set”分配)，因此即使密钥存在也返回“False”。将 obj = col(key) 行替换为 IsObject(col(key)) 以处理对象和原始值。

【解决方案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

【讨论】：

我不认为这是不优雅的......这是一种尝试捕获方法，在 C++ 和 java 中非常正常，例如我敢打赌，迭代整个集合要快得多，因为 VB 计算了提供的键的哈希值，并在哈希表上搜索它，而不是在项目的集合中。
这个实现不好：即如果出现 #5 以外的任何其他错误，它将返回 True
errNumber 在这里不是 5，而是 3265 :( ...从这方面来看并不优雅——依赖硬编码的错误代码

【解决方案3】：

最好的办法是遍历集合的成员，看看是否有任何匹配您正在寻找的内容。相信我，我必须这样做很多次。

第二种解决方案（更糟糕）是捕获“项目不在集合中”错误，然后设置一个标志来表示该项目不存在。

【讨论】：

这真的是唯一的方法吗？
“正确”也许，但仍然非常不令人满意。谢谢。
说实话，我发现 Access 本身作为一个编程平台并不能令人满意。但是我们必须使用我们收到的牌。 :-)
VB6/VBA 集合不只是您可以迭代的东西。它还提供可选的密钥访问。
以下 Mark Nold 提供的解决方案非常出色

【解决方案4】：

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

我为我的环境提出了最快的选项，当集合既有对象又有原语时，它不会失败。

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。

【讨论】：

优秀的解决方案，简洁。谢谢！
轻微改进是排除f变量，即直接调用IsObject(col.item(key))
@user2426679 谢谢！我喜欢减少代码量的微小改进:)

【解决方案5】：

您可以为此缩短建议的代码，并针对意外错误进行概括。给你：

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

【讨论】：

【解决方案6】：

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

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

【讨论】：

【解决方案7】：

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

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

【讨论】：

【解决方案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

【讨论】：

【解决方案9】：

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

' 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

【讨论】：

【解决方案10】：

对于key未用于收集的情况：

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

【讨论】：

请编辑更多信息。不建议使用纯代码和“试试这个”的答案，因为它们不包含可搜索的内容，也没有解释为什么有人应该“试试这个”。
在速度方面这是一个灾难性的解决方案，ON ERROR 解决方案要好得多：见low-bandwidth.blogspot.com.au/2013/12/…
解决方案是最好的，当集合不包含键时，只有项目，因为在这种情况下 ON ERROR 解决方案将不起作用。这个简单的解决方案需要什么解释？对集合成员进行循环并检查是否相等。

【解决方案11】：

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

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}

【讨论】：

【解决方案12】：

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

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

我不会复制完整的解释，因为它在链接页面上可用。复制解决方案本身，以防页面最终在将来变得不可用。

我对代码的怀疑是在第一个 If 块中过度使用了 GoTo，但这对任何人来说都很容易解决，所以我将保留原始代码。

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'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

【讨论】：

【解决方案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

【讨论】：

【解决方案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

【讨论】：

【解决方案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

【讨论】：