Bestimmen, ob ein Objekt ein Mitglied einer Sammlung in VBA ist
-
02-07-2019 - |
Frage
Wie kann ich feststellen, ob ein Objekt ein Mitglied einer Sammlung in VBA ist?
Insbesondere muß ich, ob eine Tabellendefinition, um herauszufinden, ist ein Mitglied der TableDefs
Sammlung.
Lösung
Am besten ist es, die Mitglieder der Sammlung iterieren und sehen, ob eine Übereinstimmung, was Sie suchen. Vertrauen Sie mir Ich habe das viele Male zu tun.
Die zweite Lösung (was viel schlimmer ist) ist es, die „Item nicht in der Sammlung“ Fehler abzufangen und stellen Sie dann eine Flagge zu sagen, dass das Element nicht existiert.
Andere Tipps
Ist es nicht gut genug?
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
Nicht gerade elegant, aber die beste (und schnellste) Lösung i OnError wurde mit gefunden. Dies wird deutlich schneller als Iteration für jede mittlere bis große Sammlung.
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
Dies ist eine alte Frage. Ich habe alle sorgfältig überprüft die Antworten und Kommentare, testeten die Lösungen für die Leistung.
Ich kam mit der schnellsten Option für meine Umgebung auf, die nicht ausfällt, wenn ein Sammlungsobjekt sowie Primitiven hat.
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
Darüber hinaus ist diese Lösung hängt nicht von hartcodierte Fehlerwerten. So kann der Parameter col As Collection
durch eine andere Sammlung Variable vom Typ ersetzt werden, und die Funktion muss noch arbeiten. Zum Beispiel auf meinem aktuellen Projekt, ich werde es als col As ListColumns
habe.
habe ich diese Lösung aus den oben genannten Vorschlägen gemischt mit microsofts Lösung durch eine Sammlung zur Iteration.
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
Sie können den vorgeschlagenen Code für diese verkürzen sowie für unerwartete Fehler verallgemeinern. Hier gehen Sie:
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
In Ihrem speziellen Fall (TableDefs) Iterieren über die Sammlung und den Namen Überprüfung ist ein guter Ansatz. Das ist in Ordnung, weil der Schlüssel für die Sammlung (Name) eine Eigenschaft der Klasse in der Sammlung ist.
Aber im allgemeinen Fall von VBA Sammlungen, wird der Schlüssel nicht unbedingt Teil des Objekts in der Sammlung (zB Sie mit einer Sammlung als Wörterbuch werden könnten, mit einem Schlüssel, der nichts mit dem Objekt zu tun hat, in der Sammlung). In diesem Fall haben Sie keine andere Wahl, als das Element, um zu versuchen den Zugriff auf und die Fehler zu kontrollieren.
Ich habe einige bearbeiten, am besten arbeiten für Sammlungen:
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
Diese Version funktioniert für primitive Typen und Klassen (Kurztest-Methode enthalten)
' 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
Es erfordert einige zusätzliche Anpassungen, falls die Elemente in der Auflistung sind nicht Objekte, sondern Arrays. Anders als das es funktionierte gut für mich.
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
Quelle: http: //coderstalk.blogspot.com/2007/09/visual-basic-programming-how-to-check.html
Für den Fall, wenn der Schlüssel für die Sammlung nicht verwendet wird:
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
Nicht mein Code, aber ich denke, es ist ziemlich gut geschrieben. Es ermöglicht durch den Schlüssel sowie durch das Objektelement selbst und übernimmt sowohl die On Error-Methode und Iterieren durch alle Elemente der Auflistung zu überprüfen.
https://danwagner.co/ how-to-Check-if-a-sammel enthält-an-Objekt /
Ich werde die vollständige Erklärung nicht kopieren, da es auf der verlinkten Seite zur Verfügung steht. Lösung selbst für den Fall, kopiert wird die Seite eventuell nicht verfügbar in der Zukunft.
Der Zweifel ich über den Code habe, ist die Übernutzung von GoTo im ersten Wenn der Block, aber das ist für jedermann leicht zu beheben, so den ursprünglichen Code, den ich verlassen, wie es ist.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'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
Ich habe es so, eine Variation auf Vadims Code aber für mich ein bisschen besser lesbar:
' 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
Ich schrieb diesen Code. Ich denke, es kann jemand helfen ...
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