Determinando se um object é um membro de uma coleção no VBA

Como posso determinar se um object é membro de uma coleção no VBA?

Especificamente, preciso descobrir se uma definição de tabela é um membro da coleção TableDefs .

Sua melhor aposta é fazer uma iteração sobre os membros da coleção e ver se alguma coincide com o que você está procurando. Confie em mim eu tive que fazer isso muitas vezes.

A segunda solução (que é muito pior) é pegar o erro “Item não na coleção” e depois definir um sinalizador para dizer que o item não existe.

Não é bom o suficiente?

 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 

Não exatamente elegante, mas a melhor (e mais rápida) solução que encontrei foi usar OnError. Isso será significativamente mais rápido que a iteração para qualquer coleção de médio a grande porte.

 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 

Eu criei esta solução a partir das sugestões acima misturadas com a solução microsofts para iterar através de uma coleção.

 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 

Você pode encurtar o código sugerido para isso, bem como generalizar para erros inesperados. Aqui está:

 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 é uma questão antiga. Revisei cuidadosamente todas as respostas e comentários, testei as soluções para o desempenho.

Eu vim com a opção mais rápida para o meu ambiente, que não falha quando uma coleção tem objects, bem como primitivos.

 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 

Além disso, essa solução não depende de valores de erro codificados. Portanto, o parâmetro col As Collection pode ser substituído por alguma outra variável de tipo de coleção, e a function ainda deve funcionar. Por exemplo, no meu projeto atual, vou tê-lo como col As ListColumns .

No seu caso específico (TableDefs) iterar sobre a coleção e verificar o nome é uma boa abordagem. Isso está OK porque a chave para a coleção (Name) é uma propriedade da class na coleção.

Mas no caso geral de collections VBA, a chave não será necessariamente parte do object na coleção (por exemplo, você poderia estar usando uma coleção como um dictionary, com uma chave que não tem nada a ver com o object na coleção). Nesse caso, você não tem escolha a não ser tentar acessar o item e detectar o erro.

Eu tenho alguma edição, melhor trabalhando para collections:

 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 versão funciona para tipos primitivos e para classs (método de teste curto incluído)

 ' 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 

Isso requer alguns ajustes adicionais caso os itens na coleção não sejam Objetos, mas Matrizes. Além disso, funcionou bem para mim.

 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 

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

Para o caso em que a chave não é utilizada para coleta:

 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 

Não é meu código, mas acho que está bem escrito. Ele permite verificar pela chave, bem como pelo próprio elemento Object e manipula o método On Error e itera todos os elementos da coleção.

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

Não vou copiar a explicação completa, pois está disponível na página vinculada. Solução copiada caso a página eventualmente fique indisponível no futuro.

A dúvida que tenho sobre o código é o uso excessivo de GoTo no primeiro bloco If, mas isso é fácil de corrigir para qualquer pessoa, por isso estou deixando o código original 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 

Eu fiz assim, uma variação no código de Vadims, mas para mim um pouco mais legível:

 ' 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 

Eu escrevi este código. Eu acho que pode ajudar alguém …

 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 
Intereting Posts