workbooks - Determinar si un objeto es miembro de una colección en VBA

variables objeto vba excel

Question

¿Cómo determino si un objeto es miembro de una colección en VBA?

Específicamente, necesito averiguar si una definición de tabla es miembro de la colección TableDefs .

Answer 1

¿No es lo suficientemente bueno?

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

Creé esta solución a partir de las sugerencias anteriores combinadas con la solución microsofts de para iterar a través de una colección.

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 3

En su caso específico (TableDefs) iterar sobre la colección y verificar el nombre es un buen enfoque. Esto está bien porque la clave para la colección (Nombre) es una propiedad de la clase en la colección.

Pero en el caso general de las colecciones de VBA, la clave no será necesariamente parte del objeto de la colección (por ejemplo, podría estar utilizando una Colección como diccionario, con una clave que no tiene nada que ver con el objeto de la colección). En este caso, no tiene más remedio que intentar acceder al elemento y detectar el error.

Answer 4

Escribí este código Creo que puede ayudar a alguien ...

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

Answer 5

Esta es una vieja pregunta. Revisé cuidadosamente todas las respuestas y comentarios, probé las soluciones para el rendimiento.

Se me ocurrió la opción más rápida para mi entorno, que no falla cuando una colección tiene objetos y primitivas.

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

Además, esta solución no depende de los valores de error codificados. Por lo tanto, el parámetro col As Collection puede ser sustituido por alguna otra variable de tipo colección, y la función aún debe funcionar. Por ejemplo, en mi proyecto actual, lo tendré como col As ListColumns .

Answer 6

Lo hice así, una variación del código Vadims pero para mí un poco más legible:

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

No es mi código, pero creo que está muy bien escrito. Permite verificar tanto por la clave como por el elemento Object en sí y maneja tanto el método On Error como la iteración a través de todos los elementos de la Colección.

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

No copiaré la explicación completa ya que está disponible en la página vinculada. La solución se copió en caso de que la página finalmente no esté disponible en el futuro.

La duda que tengo sobre el código es el uso excesivo de GoTo en el primer bloque If, ​​pero eso es fácil de arreglar para cualquiera, así que dejo el código original tal como está.

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

No exactamente elegante, pero la mejor (y más rápida) solución que pude encontrar fue el uso de OnError. Esto será significativamente más rápido que la iteración para cualquier colección de mediano a grande.

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 9

Para el caso en que la clave no se usa para la recopilación:

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 10

Puede acortar el código sugerido para esto así como generalizar para errores inesperados. Aqui tienes:

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 11

Requiere algunos ajustes adicionales en caso de que los elementos de la colección no sean Objetos, sino Matrices. Aparte de eso, funcionó bien para mí.

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

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

Answer 12

Su mejor opción es iterar sobre los miembros de la colección y ver si coinciden con lo que está buscando. Créeme, he tenido que hacer esto muchas veces.

La segunda solución (que es mucho peor) es detectar el error "Artículo no en recopilación" y luego establecer una bandera para indicar que el elemento no existe.

Answer 13

Tengo un poco de edición, el mejor trabajo para colecciones:

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 14

esta versión funciona para tipos primitivos y para clases (método de prueba corto incluido)

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