Software für Sie.

In PHP kann man sehr übersichtlich mit assoziativen Arrays arbeiten, wie zum Beispiel

$MeinArray['Vorname'] = 'Manfred';

In Excel geht das auch:

Setzen Sie im VBA-Editor unter Extras ▸ Verweise ein Häkchen vor Microsoft Scripting Runtime oder verwenden Sie Late Binding wie in den folgenden Beispielen. Nun können Sie wie folgt mit assoziativen Arrays arbeiten:

Basis ist das Dictionary oder die Collection. Dabei spielen immer Paare eine Rolle: Key=Item, also ein Schlüsselname und der Eintrag dazu. In den folgenden Beispielen wird der Einfachheit halber (und weil Collection ein paar Nachteile hat) nur das Dictionary verwendet.

Im Code sind hier die einzelnen Inhalte (Keys, Items) zum besseren Verständnis hardcodiert, also fest eingetragen. An dieser Stelle können natürlich auch Variablen oder Zellen verwendet werden, zum Beispiel Spalten- oder Zeilenüberschriften und Zellen mit Daten.

Eine Ebene

Im Beispiel sind die Key=Item-Paare auf einer Ebene. Das heiÃ?t, es darf auch keine zwei gleichnamigen Keys geben, sonst wird eine Fehlermeldung ausgegeben.

Sub AssozArray_Einfach() Dim dict, varKey, varKeys, varItems Dim intI As Integer Set dict = CreateObject("Scripting.Dictionary") dict.Add "name", "Müller" dict.Add "vorname", "Johann" dict.Add "wohnort", "Berlin" MsgBox dict("vorname") & " " & dict("name") & " wohnt in " & vbNewLine & dict("wohnort") & "." 'For Each varKey In dict.keys ' MsgBox varKey & vbNewLine & dict(varKey) 'Next varKeys = dict.Keys varItems = dict.Items For intI = 0 To dict.Count - 1 MsgBox varKeys(intI) & ": " & vbNewLine & varItems(intI) Next Set dict = Nothing End Sub

Die MsgBox zeigt, wie die Syntax Dictionary(Key) verwendet werden kann, um auf die einzelnen Elemente zuzugreifen. Darunter sind zwei Schleifen. Mit ihnen wird demonstriert, wie alle Elemente des Dictionarys ausgegeben werden können.

---

Verschachtelungen, mehrere Ebenen

Elemente von Arrays können wiederum Arrays sein. Dies geht auch bei den assoziativen Arrays bzw. Dictionarys in VBA - auch hier kann verschachtelt werden. Dabei trifft genau das Prinzip der Paare zu, nur dass an der Stelle des Items eine weitere Sammlung (Dictionary oder Collection) ist. Hier wird ein temporäres Dictionary verwendet, das vor jeder Verschachtelung neu erzeugt und danach wieder auf Nothing gesetzt wird. Vorbelegen oder �berschreiben der Items in den einzelnen Schritten funktioniert nicht, da sonst nur auf die letzten Einträge referenziert wird.

Wir wollen im Beispiel ein Dictionary aus sechs Personen erzeugen, das sind also sechs verschiedene Keys. Diesen sechs Personen können nun Details (Nachname, Vorname, Wohnort) zugeordnet werden, müssen aber nicht. So kann der Platz für eine Person auch nur reserviert sein, ohne dass Details enthalten sind.

Die Personen insgesamt sind die Einträge in dicPersonen mit den Keys Person x. Werden Details zugeordnet, erfolgt das Speichern zunächst im temporären Dictionary dictDetails, das dann als Item der Person zugeordnet wird. Gibt es keine Details, wird als Item einfach ein String verwendet.

Sub AssozArray_Levels() Dim dicPersonen, dictDetails, varKey, varKey1 Dim strAusg As String Set dicPersonen = CreateObject("Scripting.Dictionary") Set dictDetails = CreateObject("Scripting.Dictionary") dictDetails.Add "nachname", "Müller" dictDetails.Add "vorname", "Klaus" dictDetails.Add "wohnort", "Berlin" dicPersonen.Add "Person 1", dictDetails Set dictDetails = Nothing Set dictDetails = CreateObject("Scripting.Dictionary") dictDetails.Add "nachname", "Beispielfrau" dictDetails.Add "vorname", "Bärbel" dictDetails.Add "wohnort", "Hamburg" dicPersonen.Add "Person 2", dictDetails Set dictDetails = Nothing Set dictDetails = CreateObject("Scripting.Dictionary") dictDetails.Add "nachname", "Mustermann" dictDetails.Add "vorname", "Franz" dictDetails.Add "wohnort", "Leipzig" dicPersonen.Add "Person 3", dictDetails Set dictDetails = Nothing dicPersonen.Add "Person 4", "Nicht vergeben." Set dictDetails = CreateObject("Scripting.Dictionary") dictDetails.Add "nachname", "Sonne" dictDetails.Add "vorname", "Klara" dictDetails.Add "wohnort", "München" dicPersonen.Add "Person 5", dictDetails Set dictDetails = Nothing dicPersonen.Add "Person 6", "Auch nicht vergeben." MsgBox "Testausgabe: " & vbNewLine & dicPersonen("Person 1")("wohnort") & vbNewLine & dicPersonen("Person 2")("wohnort") strAusg = "" For Each varKey In dicPersonen.keys strAusg = strAusg & vbNewLine & "Person: " & varKey & vbNewLine On Error Resume Next For Each varKey1 In dicPersonen(varKey).keys strAusg = strAusg & "key: " & varKey1 & vbTab & "item: " & dicPersonen(varKey)(varKey1) & vbNewLine Next If Err.Number = 92 Then strAusg = strAusg & vbTab & vbTab & "item: " & dicPersonen(varKey) & vbNewLine Err.Clear End If Next MsgBox strAusg Set dicPersonen = Nothing End Sub

In der MsgBox mit der Testausgabe ist zu sehen, wie die Items ausgegeben werden können. Wir haben hier also nicht nur den Key einer Ebene, sondern hier wird mit Klammerpaaren bis zur unteren Ebene gearbeitet.

Schwieriger ist es mit der kompletten Ausgabe per Schleife. Hätten wir konsequent bei jeder Person eine Verschachtelung mit den Details, würde so etwas reichen:

For Each varKey In dicPersonen.keys strAusg = strAusg & vbNewLine & "Person: " & varKey & vbNewLine For Each varKey1 In dicPersonen(varKey).keys strAusg = strAusg & "key: " & varKey1 & vbTab & "item: " & dicPersonen(varKey)(varKey1) & vbNewLine Next Next

Da aber zwischendurch unverschachtelte Items direkt auf der ersten Ebene sind (Person 4 + 6), käme es hier zu einer Fehlermeldung, dem Fehler 92. Der wird abgefangen und separat behandelt; hier wird der Eintrag direkt ausgegeben. Der Schlüssel, also der Key, ist hier ja die oberste Ebene, die Person selbst.

---

Dynamische Arrayformel

Website-Tipp

Hier gibt es gute Erklärungen von Paul Kelly (englisch): Excel VBA Dictionary â?? A Complete Guide

Vorsicht: Die Laufzeit dieser Schleifen kann sehr lang sein. Es ist deshalb mehr als ratsam, die zu durchsuchenden Ordner so stark wie möglich einzugrenzen.

Erste Möglichkeit:

Dim strPfad As String, bolWeiter As Boolean 'Aufruf Sub Suchen() strPfad = "": bolWeiter = True: Dateisuche "C:\", "test.txt" Range("A1") = strPfad End Sub Function Dateisuche(strLaufwerk, strDatei) Dim strTemp As String, strWdhlg As String On Error Resume Next strLaufwerk = strLaufwerk & IIf(Right(strLaufwerk, 1) <> "\", "\", "") strTemp = Dir(strLaufwerk & strDatei) Do While Len(strTemp) strPfad = strLaufwerk & strTemp If UCase(strTemp) = UCase(strDatei) Then Dateisuche = strPfad bolWeiter = False: Exit Function End If strTemp = Dir() Loop strTemp = Dir(strLaufwerk, vbDirectory) Do While Len(strTemp) If (strTemp <> ".") And (strTemp <> "..") Then If (GetAttr(strLaufwerk & strTemp) And vbDirectory) = vbDirectory Then If bolWeiter = True Then Dateisuche strLaufwerk & strTemp, strDatei Else Exit Function strWdhlg = Dir(strLaufwerk, vbDirectory) Do While strWdhlg <> strTemp: strWdhlg = Dir(): Loop End If End If strTemp = Dir() Loop End Function

Zweite Möglichkeit:

Sub suchen1() Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dateisuche fso.GetFolder("C:"), "test.txt" Set fso = Nothing End Sub Sub Dateisuche(objErstOrdner As Object, strDatei As String) Dim objDatei As Object, objOrdner As Object, sf As Object For Each objDatei In objErstOrdner.Files If LCase(objDatei.Name) = strDatei Then MsgBox objDatei.Path End If Next For Each objOrdner In objErstOrdner.SubFolders Dateisuche objOrdner, strDatei Next End Sub

Am einfachsten geht es sicher mit einem regulären Ausdruck (Microsoft VBScript Regular Expressions-Objektbibliothek kann auch eingebunden werden statt late binding):

Function ErsterBuchstabe(strString As String) Dim Regex As Object, regMatches If Regex Is Nothing Then Set Regex = CreateObject("VBScript.RegExp") ErsterBuchstabe = "" Regex.Pattern = "^[^A-Za-z���äöü�]*([A-Za-z���äöü�]).*" Set regMatches = Regex.Execute(strString) If regMatches.Count > 0 Then ErsterBuchstabe = regMatches(0).SubMatches(0) Set Regex = Nothing End Function

In die Zelle: =ErsterBuchstabe(A1).

Die folgende Funktion liefert das erste nichtnumerische Zeichen:

Function ErsteNichtZahl(Zelle) Dim intI As Integer If Len(Zelle) = 0 Then ErsteNichtZahl = "" For intI = 1 To Len(Zelle) If Not IsNumeric(Mid(Zelle, intI, 1)) Then ErsteNichtZahl = Mid(Zelle, intI, 1) Exit Function End If Next End Function

In die Zelle: =ErsteNichtZahl(A1).

Die nächste Funktion liefert den ersten Buchstaben einer Zeichenfolge:

Function ErsterBuchstabe1(Zelle) Dim intI As Integer If Len(Zelle) = 0 Then ErsterBuchstabe = "" For intI = 1 To Len(Zelle) If (Asc(Mid(Zelle, intI, 1)) >= 65 And Asc(Mid(Zelle, intI, 1)) <= 90) Or _ (Asc(Mid(Zelle, intI, 1)) >= 97 And Asc(Mid(Zelle, intI, 1)) <= 122) Or _ Asc(Mid(Zelle, intI, 1)) = 196 Or _ Asc(Mid(Zelle, intI, 1)) = 196 Or _ Asc(Mid(Zelle, intI, 1)) = 214 Or _ Asc(Mid(Zelle, intI, 1)) = 220 Or _ Asc(Mid(Zelle, intI, 1)) = 228 Or _ Asc(Mid(Zelle, intI, 1)) = 246 Or _ Asc(Mid(Zelle, intI, 1)) = 252 Then ErsterBuchstabe = Mid(Zelle, intI, 1) Exit Function Else: ErsterBuchstabe = "" End If Next End Function

In die Zelle: =ErsterBuchstabe(1A1) eingegeben werden.