Hier nun wie im Thread: angekündigt, die VBAstelei mit Collections
Im Gegensatz zu Dictionary ist Dollection ein Bestandteil der VBA-Standardbibiliothek
Bei COLLECTION gilt:
- Es ist nicht überprüfbar ob ein Key existiert
- Man kann nicht das Item(Wert/Value) verändern, wenn das Item zum Key gespeichert ist. (-> da ein Objekt)
-> es gibt eine einzige Ausnahme, dies wird in der Sub-Routine "KeyExists" dargestellt.
Die Daten erfassen wir mit folgendem Snippet.
Code: Alles auswählen
Sub SystemInfosCollection()
Set m_colSystemInfos = New Collection
With m_colSystemInfos
.Add Application.OperatingSystem, "Betriebssystem"
.Add Application.Version, "ExcelVersion"
.Add Application.UserName, "Benutzer Excel"
.Add Environ("USERNAME"), "Benutzer angemeldet"
.Add pc_strLicence, "Lizenz"
End With
End Sub
Code: Alles auswählen
Function GetSystemInfoCollection(strKey As String)
'Get the System Data
Call SystemInfosCollection
'Attention you cannot check if the Key exists
GetSystemInfoCollection = m_colSystemInfos("Betriebssystem")
End Function
Auch hier gilt: Man kann noch bestimmen, ob die einzelnen Datensätze zeilenweise (bolPopulateVertically = True) oder spaltenweise (bolPopulateVertically = False) übertragen werden sollen.
Sub PopulateCollectionDataToWorksheet(Optional strSheetName As String = "SystemInfos", Optional bolPopulateVertically As Boolean = True)
Dim wksSheet As Worksheet 'The Worksheet to populate the data
Dim rngRange As Range
Set wksSheet = ThisWorkbook.Worksheets(strSheetName)
Dim varItem As Variant 'Variable: Several items in the Collection
Dim i As Long 'Counter
'Get the System Info Data
Call SystemInfosCollection
'initialize
wksSheet.Range("A1").CurrentRegion.Delete
i = 0
With wksSheet
For Each varItem In m_colSystemInfos
i = i + 1
If bolPopulateVertically = True Then 'vertically
.Cells(i, 1).Value = varItem
Else 'horizontally
.Cells(1, i).Value = varItem
End If
Next varItem
End With
End Sub
Wie angekündigt als Bonus noch ein "Workaround" wie man das Vorhandensein eines "Keys" in einer Collection überprüfen kann.
Dies funktioneert nur, wenn Key:= = Item:=! Also zum Beispiel bei Woksheet.Name (Worksheet ist - ja - eine Auflistung ("Collection").
Code: Alles auswählen
'This Function works only if the values in the collection are unique and the item is added as key too
Function KeyExists(objCollection As Collection, strKey As String) As Boolean
On Error GoTo ErrorHandler
If IsObject(objCollection.Item(strKey)) Then KeyExists = True
ErrorHandler:
End Function
Viel Spaß und abschließend dank an snb.