Determinar si un objeto es miembro de una colección en VBA
-
02-07-2019 - |
Pregunta
¿Cómo determino si un objeto es miembro de una colección en VBA?
Específicamente, necesito saber si una definición de tabla es miembro de la colección TableDefs
.
Solución
Su mejor apuesta es iterar sobre los miembros de la colección y ver si alguno coincide con lo que está buscando. Créeme, he tenido que hacer esto muchas veces.
La segunda solución (que es mucho peor) es capturar el " Objeto que no está en la colección " error y luego establecer una bandera para decir que el elemento no existe.
Otros consejos
¿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 es exactamente elegante, pero la mejor (y más rápida) solución que pude encontrar fue usar OnError. Esto será significativamente más rápido que la iteración para cualquier colección de mediana 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
Esta es una vieja pregunta. He revisado cuidadosamente todas las respuestas y comentarios, y he probado 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 además de primitivos.
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
Además, esta solución no depende de los valores de error codificados. Por lo tanto, el parámetro col As Collection
puede sustituirse por alguna otra variable de tipo de colección, y la función aún debe funcionar. Por ejemplo, en mi proyecto actual, lo tendré como col As ListColumns
.
Creé esta solución a partir de las sugerencias anteriores mezcladas con la solución de microsofts 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. Aquí 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
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 VBA, la clave no necesariamente será parte del objeto en la colección (por ejemplo, podría estar usando una Colección como un diccionario, con una clave que no tiene nada que ver con el objeto en el 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, mejor trabajando 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
' 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
Requiere algunos ajustes adicionales en caso de que los elementos de la colección no sean Objetos, sino Arreglos. 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 cuando la clave no se utiliza para la colecció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á bastante bien escrito. Permite verificar por la clave, así 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/ cómo-verificar-si-una-colección-contiene-un-objeto /
No copiaré la explicación completa ya que está disponible en la página vinculada. La solución se copia en caso de que la página 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 es fácil de solucionar para cualquier persona, por lo que estoy dejando 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 en el código de 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. Supongo 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