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

¿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 .

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 recostackción” y luego establecer una bandera para indicar que el elemento no existe.

¿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 

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 

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 

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 

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 .

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.

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 

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

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

Para el caso en que la clave no se usa para la recostackció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 

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 

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 

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