Determining whether an object is a member of a collection in VBA

前端 未结 15 1739
自闭症患者
自闭症患者 2020-11-27 05:35

How do I determine whether an object is a member of a collection in VBA?

Specifically, I need to find out whether a table definition is a member of the TableDe

相关标签:
15条回答
  • 2020-11-27 05:52

    i used this code to convert array to collection and back to array to remove duplicates, assembled from various posts here (sorry for not giving properly credit).

    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
    
    0 讨论(0)
  • 2020-11-27 05:53

    I wrote this code. I guess it can help someone...

    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
    
    0 讨论(0)
  • 2020-11-27 05:56

    It requires some additional adjustments in case the items in the collection are not Objects, but Arrays. Other than that it worked fine for me.

    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
    

    Source: http://coderstalk.blogspot.com/2007/09/visual-basic-programming-how-to-check.html

    0 讨论(0)
  • 2020-11-27 05:57

    Not exactly elegant, but the best (and quickest) solution i could find was using OnError. This will be significantly faster than iteration for any medium to large collection.

    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
    
    0 讨论(0)
  • 2020-11-27 05:57

    You can shorten the suggested code for this as well as generalize for unexpected errors. Here you go:

    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
    
    0 讨论(0)
  • 2020-11-27 05:58

    this version works for primitive types and for classes (short test-method included)

    ' 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
    
    0 讨论(0)
提交回复
热议问题