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

Question

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

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

score 77 · Accepted Answer

还不够好吗？

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

score 40 · Accepted Answer

不完全优雅，但我能找到的最好（也是最快）的解决方案是使用 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

score 27 · Accepted Answer

你最好的选择是遍历集合的成员，看看是否有任何匹配你正在寻找的东西。相信我，我不得不这样做很多次。

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

score 15 · Accepted Answer

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

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

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.

score 3 · Accepted Answer

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

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

score 2 · Accepted Answer

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

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

score 2 · Accepted Answer

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

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

score 2 · Accepted Answer

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

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

score 1 · Accepted Answer

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

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}

score 1 · Accepted Answer

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

' 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

score 1 · Accepted Answer

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

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

score 0 · Accepted Answer

不是我的代码，但我认为它写得很好。它允许通过键和 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

score 0 · Accepted Answer

我使用此代码将数组转换为集合并返回数组以删除重复项，这些重复项是从此处的各种帖子中组装而成的（对不起，没有给予适当的信任）。

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

score -1 · Accepted Answer

我这样做了，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

score -1 · Accepted Answer

我写了这段代码。我想它可以帮助某人...

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 - 确定对象是否是 VBA 中集合的成员

15 回答 15

Related

Reference