Определение того, является ли объект членом коллекции в VBA - PullRequest
58 голосов
/ 26 сентября 2008

Как определить, является ли объект членом коллекции в VBA?

В частности, мне нужно выяснить, является ли определение таблицы членом коллекции TableDefs.

Ответы [ 14 ]

0 голосов
/ 09 февраля 2018

Не мой код, но я думаю, что он довольно хорошо написан. Он позволяет выполнять проверку как по ключу, так и по самому элементу Object и обрабатывает как метод On Error, так и итерацию по всем элементам Collection.

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

Я не буду копировать полное объяснение, поскольку оно доступно на связанной странице. Само решение копируется на случай, если страница в конечном итоге станет недоступной в будущем.

Я сомневаюсь в коде из-за чрезмерного использования GoTo в первом блоке If, но это легко исправить для любого, поэтому я оставляю исходный код таким, какой он есть.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'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
0 голосов
/ 13 сентября 2016

Для случая, когда ключ не используется для сбора:

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
0 голосов
/ 05 августа 2015

Я написал этот код. Я думаю, это может кому-то помочь ...

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 голосов
/ 16 июля 2015

Я сделал это следующим образом, вариант кода Вадима, но для меня он немного более читабелен:

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