确定对象是否是在一个VBA集合的成员(Determining whether an object i

2019-06-21 19:43发布

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

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

Answer 1:

最好的办法是遍历集合中的成员,看看是否有匹配你所寻找的。 相信我,我不得不这样做了很多次。

第二个解决方案(这是更糟糕)是捕捉“项目不是在收集”的错误,然后设置一个标志,表示该项目不存在。



Answer 2:

是不是不够好?

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 3:

不完全是优雅的,但最好的(和最快)解决方案,我可以找到使用的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 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)遍历集合并检查该名称是一个好方法。 这是可以的,因为对于集合(名称),关键是集合中的类的属性。

但在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:

这个版本适用于原语类型和类(包括短的测试方法)

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

它要求在一些情况下,集合中的项目不是对象,但数组额外的调整。 除此之外,它的工作对我罚款。

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 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元素本身进行检查和处理两者上的错误方法,并通过所有的集合元素进行迭代。

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

因为它是可用的链接页面上,我会不会复制完整的解释。 解决方案本身的情况下,复制的页面最终成为在未来不可用。

该怀疑我对代码转到在第一个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:

我这样做是这样的,在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 14:

我写了这个代码。 我想这可以帮助别人...

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


文章来源: Determining whether an object is a member of a collection in VBA