Datenschutzerklärung


Direktnachricht



Ihre Software
Details
Excel/VBA 🔍
Add-Ins

Suche in Beispielen und Tipps zu Excel und VBA

Suchbegriff(e) mit Leerzeichen getrennt:

Anleitung: Zelldaten in Userform und zurückMakro/Sub/ProzedurTipp

Kategorie: Steuerelemente ▸ Userform

(Tipp 76) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich Daten aus Zellen in eine Userform-Listbox einlesen lassen, die zugehörigen Angaben beim Klick auf die Listbox in Textboxen anzeigen lassen und Änderungen in der Userform in die Zellen schreiben lassen?

Bei der Arbeit mit Userforms gibt es immer verschiedene Wege, die zu einem Ziel führen. Die Kunst ist immer, Techniken/Konzeptionen zu wählen, die den eigenen Anforderungen am besten entsprechen; die am sichersten sind, möglichst kurze Laufzeiten aufweisen und Ressourcen am besten schonen. Darum soll es hier aber nicht gehen. An dieser Stelle stehen grundsätzliche Möglichkeiten im Mittelpunkt, die aufzeigen, wie die Aufgabenstellung prinzipiell gelöst werden kann. Auf Fehlerbehandlungen, Ergonomie und Schönheit wird hier deshalb verzichtet.

Für das Beispiel wird die abgebildete kleine Tabelle auf dem Blatt Daten verwendet; funktionieren soll dann die Userform1 mit den folgenden grundsätzlichen Elementen:

  • Listbox1 (das wird die Obstliste)
  • TextBox1
  • TextBox2
  • TextBox3
  • TextBox4
  • CommandButton1 (Neu)
  • CommandButton2 (Schließen)

Tipp: Auch wenn wir hier die Standardbezeichnungen der Elemente verwenden - übersichtlicher ist es, wenn Sie jedem Element eine aussagekräftige Eigenschaft bei Name vergeben. Commandbutton1 könnte so zum Beispiel cmdNeu genannt werden.

Nun müssen wir uns schon entscheiden: Der Code kann in ein allgemeines Modul (Modul1, Modul2, …) oder in diesem Fall in das Klassenmodul der Userform. Nehmen wir ein allgemeines Modul, muss im Code immer die gesamte Userform angesprochen werden, denn allgemeine Module stehen für die gesamte (in diesem Fall) Mappe - wenn mit mehreren Userforms gearbeitet würde, müsste der Code dort wissen, welche Userform angesprochen werden soll. Wir entscheiden uns hier für das Klassenmodul der Userform, das konkret dieser Userform zugeordnet ist.

Klassenmodul der Userform: Basis für den Code

In das Modul der Userform gelangt man am einfachsten und schnellsten, indem man auf das Element, für das der Code erstellt werden soll, doppelklickt. Wir wollen zuerst einmal dafür sorgen, dass die Userform per Klick auf Schließen geschlossen werden kann. Dazu also ein Doppelklick auf den Button (Commandbutton2 war das). Wir gelangen in das Klassenmodul, haben schon den vorbereiteten Code, der für das Klicken auf den Button zuständig ist und tragen dort einfach Unload Me ein:

Private Sub CommandButton2_Click() Unload Me End Sub

Mit F5 kann das auch gleich getestet werden Userform aufrufen und Button anklicken.

Einlesen der Daten aus der Tabelle

Der nächste Schritt ist das Einlesen der Daten von der Tabelle in die Listbox. Dies soll geschehen, wenn die Userform aufgerufen, also geladen wird.

Dazu wählen wir - wenn es noch nicht eingestellt ist - links oben das Element, die Userform. Rechts wählen wir das Ereignis, also wann es geschehen soll. Das ist hier Initlialize.

Wenn wir das gewählt haben, steht auch schon der Code dafür da, den wir vervollständigen. Im ersten Beispiel wählen wir die gebundene Form - die Daten erscheinen in der Listbox genau so, wie sie in der Tabelle stehen:

Private Sub UserForm_Initialize() ListBox1.RowSource = "Daten!B2:B10" End Sub

Manchmal kann es jedoch notwendig sein, die Daten ungebunden in die Liste einzutragen, wenn zum Beispiel Einträge ergänzt werden sollen. Im folgenden Beispiel wird dies gezeigt, indem die Daten aus Spalte A vorangestellt werden. Verwendet werden hier die Daten von Zeile 2 bis zur letzten in Spalte 2 ausgefüllten Zelle:

Private Sub UserForm_Initialize() 'ListBox1.RowSource = "Daten!B2:B10" Dim lngZ As LongPtr With Sheets("Daten") For lngZ = 2 To .Cells(Rows.Count, 2).End(xlUp).Row ListBox1.AddItem .Cells(lngZ, 1) & " - " & .Cells(lngZ, 2) Next End With End Sub

Im zweiten Beispiel sind die Daten ungebunden in der Liste - ändern sich die Daten in der Tabelle, bleibt die Listbox so, wie sie erstellt wurde.

Details zu gewähltem Listeneintrag anzeigen

Nun können wir unsere Einträge in der Liste anklicken, aber es passiert natürlich noch nichts. Dass rechts in den Textboxen die Details zum angeklickten Eintrag erscheinen, müssen wir erst eingeben. Es soll etwas beim Anklicken der Listbox passieren - also doppelklicken wir im Editor doppelt auf die Listbox und haben den Rahmen für den Code:

Private Sub ListBox1_Click() End Sub

Zunächst einmal ist wichtig, aus welcher Zeile des Tabellenblattes die Daten kommen sollen, wenn wir auf einen Eintrag in der Listbox klicken.

Dazu nutzen wir die Listindex-Eigenschaft der Listbox. Wenn wir in einer Listbox einen Eintrag auswählen, hat der immer einen Listindex, beginnend mit 0. Ist kein Eintrag ausgewählt, ist der Listindex -1.

Wenn wir also den ersten Eintrag anklicken, sollen die Daten aus der Zeile 2 erscheinen, beim zweiten Eintrag die Daten aus Zeile 3 usw. Wir addieren also zum Listindex einfach 2 und verwenden für die einzelne Textbox den jeweiligen Eintrag aus den Spalten 1 bis 4. Das kann so aussehen:

Dim intIndex As Integer intIndex = ListBox1.ListIndex With Sheets("Daten") TextBox1.Text = .Cells(intIndex + 2, 1) TextBox2.Text = .Cells(intIndex + 2, 2) TextBox3.Text = .Cells(intIndex + 2, 3) TextBox4.Text = .Cells(intIndex + 2, 4) End With

Nun kann allerdings der Fall eintreten, dass mal kein Eintrag gewählt ist. Dann sollen die Textboxen leer sein. Dafür verwenden wir hier eine kleine Schleife - da wir das später nochmal benötigen, lagern wir das in eine separate Sub() aus, die wir dann einfach aufrufen:

Sub TextBoxenLeer() Dim ctrControl As Control For Each ctrControl In Me.Controls If ctrControl.Name Like "TextBox*" Then ctrControl.Text = "" Next End Sub

Damit vervollständigen wir den Code der Listbox, so dass er so aussieht und wir es mit z. B. F5 testen können:

Private Sub ListBox1_Click() Dim intIndex As Integer intIndex = ListBox1.ListIndex If intIndex >= 0 Then With Sheets("Daten") TextBox1.Text = .Cells(intIndex + 2, 1) TextBox2.Text = .Cells(intIndex + 2, 2) TextBox3.Text = .Cells(intIndex + 2, 3) TextBox4.Text = .Cells(intIndex + 2, 4) End With Else TextBoxenLeer End If End Sub

Änderungen aus der Userform in die Tabelle übernehmen

Nun sollen Änderungen, die in den Textboxen vorgenommen werden, auch in die Tabelle übernommen werden. Hierbei ist es besonders wichtig, wie man vorgeht - bei vier Textboxen ist das sicher kein Problem, aber bei größeren Datenmasken kann bei einer unzweckmäßigen Technik schon viel überflüssiger Code entstehen. Für den Anfang sei hier jedoch nur auf das Erstellen einer separaten Klasse verwiesen oder auch auf das Verwenden eines Frames und das komplette Übernehmen mit einem Klick. Der Einfachheit halber weisen wir das Übernehmen hier den Textboxen direkt zu.

Damit wir nicht bei jeder Textbox überflüssigen Code wiederholen müssen, bereiten wir eine Sub() vor, die wir dann bei den Textboxen nur noch aufrufen. Die Sub() macht nichts anderes, als einen Wert in die Zelle lngZeile, lngSpalte zu schreiben:

Sub DatenInTabelle(ByVal lngZeile As LongPtr, ByVal lngSpalte As LongPtr, varWert) If lngZeile >= 2 Then Sheets("Daten").Cells(lngZeile, lngSpalte) = varWert End Sub

Damit das bei Änderungen in den Textboxen geschieht, müssen wir dazu noch den Code erstellen - auch hier wieder durch Doppelklick auf die einzelnen Textboxen. Dadurch erhalten wir die Code-Rahmen für die Boxen und fügen nur noch den Verweis auf die Sub ein, die wir gerade erstellt haben. Das sieht dann so aus:

Private Sub TextBox1_Change() DatenInTabelle ListBox1.ListIndex + 2, 1, TextBox1.Text End Sub Private Sub TextBox2_Change() DatenInTabelle ListBox1.ListIndex + 2, 2, TextBox2.Text End Sub Private Sub TextBox3_Change() DatenInTabelle ListBox1.ListIndex + 2, 3, TextBox3.Text End Sub Private Sub TextBox4_Change() DatenInTabelle ListBox1.ListIndex + 2, 4, TextBox4.Text End Sub

Wir sehen, dass auch hier für die Angabe der Zeile der Listindex der Listbox verwendet wird. Da der beim ersten Eintrag 0 ist, die Tabelle aber bei Zeile 2 beginnt, müssen wir hier noch die 2 addieren. Für den Fall, dass mal kein Eintrag in der Listbox gewählt ist (entspricht Listindex = -1), haben wir in Sub DatenInTabelle() noch die Abfrage If lngZeile >= 2 Then .

Damit sollte eine Änderung bei einem gewählten Eintrag übernommen werden. Da es hier um das Prinzip geht, lassen wir hier das Aktualisieren der Listeneinträge bei Änderungen der Spalten 1 und 2 außen vor. Erwähnt sei nur, dass dies einfach mit ListBox1.List(ListBox1.ListIndex) = möglich ist.

Neuer Eintrag

Fehlt eigentlich nur noch eins: Wie fügt man einen neuen Eintrag hinzu?

In diesem Fall machen wir es ganz einfach: Wir lassen in die erste leere Zelle in Spalte 2 (B) und in die Listbox einen Eintrag vornehmen und diesen in der Listbox auswählen. Der Rest funktioniert dann bereits.

Private Sub CommandButton1_Click() Dim lngZ As LongPtr With Sheets("Daten") lngZ = .Cells(Rows.Count, 2).End(xlUp).Row + 1 .Cells(lngZ, 2) = "Neuer Eintrag" End With ListBox1.AddItem "Neuer Eintrag" ListBox1.ListIndex = ListBox1.ListCount - 1 End Sub

Der Nachteil ist, dass die Liste dann diesen Eintrag behält, aber das lässt sich leicht beheben. Am einfachsten schreibt man den Code aus Einlesen der Daten aus der Tabelle in eine separate Sub und lässt die beim Aufruf der Userform und beim Erstellen eines neuen Eintrags ausführen.

Viel Erfolg!

Datum in einer Textbox mit denen einer Spalte vergleichenMakro/Sub/Prozedur

Kategorien: Steuerelemente ▸ Userform und Suchen/Ersetzen

(Tipp 78) Nachricht zum Beitrag an Autor Nach oben

Wie kann man das Datum aus dem Textfeld einer Userform mit einem Datum in der Spalte A eines Tabellenblattes vergleichen? Stimmt das Datum einer Zeile in Spalte A mit dem Textfeld in der Userform überein, sollen in dieser Zeile in den nächsten Spalten Werte aus einem zweitem Textfeld der Userform eingetragen werden.

Der Code prüft zunächst, ob in Textbox1 ein Datum enthalten ist. Wenn nicht, wird die Prozedur verlassen. Übrigens: Das Datum kann auch mit dem Minuszeichen auf dem Numblock eingegeben werden, so muss man nicht immer auf der Tastatur zum Punkt wechseln.

Anschließend wird das Datum, das in der Textbox steht, auf Tabelle1 in Spalte A gesucht. Wurde es nicht gefunden, erscheint die Meldung, ansonsten werden die Inhalte der Textboxen 2 und 3 in die Spalten B und C geschrieben.

Das Blatt Tabelle1 muss übrigens nicht aktiv sein.

Sub DatumSuchen() Dim rngZelle As Range, datDatum As Date If IsDate(UserForm1.TextBox1.Text) = False Then Exit Sub datDatum = CDate(UserForm1.TextBox1.Text) With Worksheets("Tabelle1") Set rngZelle = .Columns(1).Find(datDatum, lookat:=xlWhole) If rngZelle Is Nothing Then MsgBox "Nicht gefunden!" Else .Cells(rngZelle.Row, 2).Value = UserForm1.TextBox2.Text .Cells(rngZelle.Row, 3).Value = UserForm1.TextBox3.Text End If End With End Sub

Geburtstagskinder des heutigen Tages in Userform anzeigen (FILTER())Makro/Sub/ProzedurArrayfunktion/Matrixfunktion

Kategorien: Datum/Zeit ▸ Datum und Tabelle ▸ Matrix

(Tipp 376) Nachricht zum Beitrag an Autor Nach oben

Auf verschiedenen Blättern einer Mappe befinden sich in Spalte E Namen, in Spalte F Geburtstage und in Spalte J Telefonnummern. Wie kann ich die Geburtstagskinder des heutigen Tages in einer UserForm-Listbox anzeigen lassen?

Dafür gibt es verschiedene Möglichkeiten - wobei es mit der Find-Methode Probleme gibt, da die nach dem Datum sucht, nicht aber nach einem Teil davon. Gezeigt werden zwei Möglichkeiten - die erste funktioniert ab Excel 365, die zweite generell:


Einsatz der Tabellenfunktion FILTER() ab Excel 365

Das grundlegende Vorgehen ist hier wie bei der älteren Variante (siehe unten), nur beim Sammeln der Daten wird die Tabellenblattfunktion FILTER() verwendet. Die Blätter werden also auch einzeln abgearbeitet, pro Blatt arbeitet aber diese Funktion. Wir gehen hier davon aus, dass der Datenbereich ab Zeile 3 und ab Spalte C beginnt.

Die Funktion sorgt dafür, dass nicht jede Zeile auf dem Blatt durchlaufen werden muss, sondern dass bereits eine Ergebnismenge vorhanden ist - es müssen also weniger Daten ausgewertet werden. Sie liefert einen Array, in dem die Zeilen enthalten sind, in denen sich die gefundenen Geburtstage befinden. Die einzelnen Daten sind Elemente jeder Zeile, der Geburtstag ist das vierte Element (ab Spalte C). Die Datumsangaben liegen in diesem Array als Long-Zahlen vor, deshalb sind sie hier noch formatiert.

Für den praktischen Einsatz kann es notwendig sein, die Blätter noch etwas einzugrenzen, weil sonst Fehler auftreten könnten. Hier wird mit IsArray() geprüft, ob ein Array vorliegt, fürs Grobe reicht das erst mal. Die Routine:

Sub Geburtstage1() Dim lngLZ As LongPtr Dim intN As Integer Dim strEintrag As String Dim wksBlatt As Worksheet Dim arrS(), lngArrS As LongPtr Dim varT lngArrS = -1 For Each wksBlatt In ActiveWorkbook.Sheets lngLZ = wksBlatt.Cells(wksBlatt.Rows.Count, 4).End(xlUp).Row varT = Application.Evaluate("=FILTER(" & wksBlatt.Name & "!C3:J" & lngLZ & ",(DAY(" & wksBlatt.Name & "!F3:F" & lngLZ & ")=DAY(TODAY()))*(MONTH(" & wksBlatt.Name & "!F3:F" & lngLZ & ")=MONTH(TODAY())),0)") If IsArray(varT) Then For intN = 1 To UBound(varT) lngArrS = lngArrS + 1 ReDim Preserve arrS(lngArrS) strEintrag = Format(varT(intN, 4), "DD.MM.YYYY") & " " strEintrag = strEintrag & Format(Year(Date) - Year(varT(intN, 4)), "00") & " " strEintrag = strEintrag & varT(intN, 3) & ", " & varT(intN, 2) strEintrag = strEintrag & ", Telefon: " & varT(intN, 8) strEintrag = strEintrag & " (Blatt: " & wksBlatt.Name & ")" arrS(lngArrS) = strEintrag Next End If Next UserForm1.ListBox1.List = arrS UserForm1.Show End Sub


Alte Variante, generell funktionshähig

Hier wird das Verwenden einer Schleife aufgezeigt.

Dazu wird natürlich eine Userform benötigt, hier ist es UserForm1. Auf ihr sind die ListBox1 und ein Commandbutton zum Schließen der Userform.

Die folgende Routine, die hier in einem Standardmodul sein muss, durchläuft alle Blätter und prüft in Spalte 6 (F) auf Datumsangaben. Wenn es sich um ein Datum handelt, wird auf Übereinstimmung mit dem heutigen Tag und dem heutigen Monat geprüft. Gibt es die, wird in diesem Beispiel einfach ein String aus den Angaben gebastelt und in einen Array aufgenommen.

Am Ende wird der Array mit UserForm1.ListBox1.List an die Listbox übergeben und die Userform aufgerufen.

Sub Geburtstage() Dim lngEZ As LongPtr, lngLZ As LongPtr, lngZ As LongPtr, lngS As LongPtr Dim strEintrag As String Dim wksBlatt As Worksheet Dim arrS(), lngArrS As LongPtr lngS = 6 lngArrS = -1 For Each wksBlatt In ActiveWorkbook.Sheets lngEZ = wksBlatt.UsedRange.Row lngLZ = lngEZ + wksBlatt.UsedRange.Rows.Count If lngLZ > lngEZ Then With wksBlatt For lngZ = lngEZ To lngLZ If IsDate(.Cells(lngZ, lngS)) Then If Day(.Cells(lngZ, lngS)) = Day(Date) And Month(.Cells(lngZ, lngS)) = Month(Date) Then lngArrS = lngArrS + 1 ReDim Preserve arrS(lngArrS) strEintrag = .Cells(lngZ, 6).Text & " " strEintrag = strEintrag & Format(Year(Date) - Year(.Cells(lngZ, 6)), "00") & " " strEintrag = strEintrag & .Cells(lngZ, 5) & ", " & .Cells(lngZ, 4) strEintrag = strEintrag & ", Telefon: " & .Cells(lngZ, 10) strEintrag = strEintrag & " (Blatt: " & .Name & ")" arrS(lngArrS) = strEintrag End If End If Next End With End If Next UserForm1.ListBox1.List = arrS UserForm1.Show End Sub

Es gibt natürlich auch Alternativen. So kann z. B. der Array mehrspaltig verwendet und das Ganze zu einer Funktion umgeschrieben werden, die den Array zurückgibt und beliebig eingesetzt werden kann. Oder die Listbox wird mit ColumnCount mehrspaltig erstellt und die einzelnen Daten werden auf mehrere Spalten verteilt. Oder die Daten werden sofort in die Listbox geschrieben. Oder, oder, oder …

Soll die Geburtstagsprüfung beim Dateiaufruf erfolgen, wird im Klassenmodul DieseArbeitsmappe (doppelt anklicken) dieser Code eingefügt:

Private Sub Workbook_Open() Geburtstage End Sub

Damit der Commandbutton wirkt: Doppelklick auf den Button und diesen Code eintragen:

Private Sub CommandButton1_Click() Unload Me End Sub

Integrierte Dialogfelder aufrufenMakro/Sub/Prozedur

Kategorie: Interaktion ▸ Dialoge

(Tipp 437) Beispieldatei Nachricht zum Beitrag an Autor Nach oben

Die integrierten Dialogfelder von Excel können auch mit VBA aufgerufen werden. Dies geschieht einfach mit:

Application.Dialogs(Konstante).Show

Bei den Dialogfeldern können verschiedene Argumente mitgegeben werden, die natürlich bei jedem Element anders sind. Hierzu am besten einfach in die Hilfe sehen.

Manchmal muss man sich entscheiden, ob ein integriertes Dialogfeld oder ein herkömmliches Dialogfeld für die Aufgabe besser geeignet ist. Mit z. B. Application.GetOpenFilename kann schön der Pfad abgefragt werden, was mit xlDialogOpen schon nicht mehr so einfach ist.

lfd. Nr.KonstanteName
1xlDialogActivateAktivieren
2xlDialogActiveCellFontSchrift
3xlDialogAddinManagerAdd-In-Manager
4xlDialogAlignmentAusrichtung
5xlDialogApplyStyleFormatvorlage
6xlDialogArrangeAllFenster anordnen
7xlDialogAutoCorrectAutokorrektur
8xlDialogBorderRahmen
9xlDialogCalculationBeschriftungsoptionen
10xlDialogCellProtectionZellschutz
11xlDialogClearInhalte löschen
12xlDialogColorPaletteFarboptionen
13xlDialogColumnWidthSpaltenbreite
14xlDialogConditionalFormattingBedingte Formatierung
15xlDialogConsolidateKonsolidierung
16xlDialogCopyPictureBild kopieren
17xlDialogCreateNamesNamen erstellen
18xlDialogCustomizeToolbarAnpassen
19xlDialogCustomViewsAnsichten
20xlDialogDataSeriesReihe
21xlDialogDefineNameNamen definieren
22xlDialogDefineStyleFormatvorlage
23xlDialogDeleteFormatZahlenformat
24xlDialogDeleteNameNamen definieren
25xlDialogDemoteGruppierung
26xlDialogDisplayBildschirmanzeigeoptionen
27xlDialogEditDeleteZellen löschen
28xlDialogFileDeleteDatei löschen
29xlDialogFileSharingArbeitsmappe freigeben
30xlDialogFilterAdvancedSpezialfilter
31xlDialogFindFileDatei suchen/öffnen
32xlDialogFormatAutoAutoformat
33xlDialogFormatNumberZahlenformat
34xlDialogFormulaFindSuchen
35xlDialogFormulaGotoGehe zu
36xlDialogFormulaReplaceErsetzen
37xlDialogGoalSeekZielwertsuche
38xlDialogImportTextFileTextdatei importieren
39xlDialogInsertZellen einfügen
40xlDialogInsertHyperlinkHyperlink einfügen
41xlDialogInsertNameLabelBeschriftungsbereiche
42xlDialogInsertObjectObjekt einfügen
43xlDialogInsertPictureBild einfügen
44xlDialogNewDatei - Neu
45xlDialogOpenDatei öffnen
46xlDialogOptionsCalculationOptionen: Berechnung
47xlDialogOptionsEditOptionen: Bearbeitung
48xlDialogOptionsGeneralOptionen: Allgemein
49xlDialogOptionsListsAddOptionen: Liste
50xlDialogOptionsTransitionOptionen: Umsteigen
51xlDialogOptionsViewOtionen: Ansicht
52xlDialogPageSetupSeite einrichten
53xlDialogPasteSpecialInhalte einfügen
54xlDialogPatternsFormat: Muster
55xlDialogPrintDrucken
56xlDialogPrinterSetupDruckereinrichtung
57xlDialogPropertiesDateieigenschaften
58xlDialogProtectDocumentBlatt schützen
59xlDialogRoutingSlipMailverteiler
60xlDialogRowHeightZeilenhöhe
61xlDialogRunMakro
62xlDialogSaveAsSpeichern unter
63xlDialogSelectSpecialInhalte auswählen
64xlDialogSendMailMappe als Mail
65xlDialogSetBackgroundPictureHintergrundbild
66xlDialogSetPrintTitlesDrucktitel
67xlDialogSortSortieren
68xlDialogUnhideTabelle einblenden
69xlDialogWorkbookAddBlatt verschieben/kopieren
70xlDialogWorkbookNameBlatt umbenennen
71xlDialogWorkbookNewTabelle usw. einfügen
72xlDialogWorkbookProtectArbeitsmappe schützen
73xlDialogZoomZoom

Download: integrierte_dialogfelder.xlsm

JSON mit VBA erstellen und an den Server schickenMakro/Sub/Prozedur

Kategorien: Netz ▸ Serverkommunikation und Stringoperationen ▸ JSON

(Tipp 598) Beispieldatei Nachricht zum Beitrag an Autor Nach oben

Wie kann ich mit VBA das Json-Format erstellen und z. B. an PHP senden?

Am einfachsten und schnellsten geht es sicher mit dem JsonConverter von Tim Hall. Die Installation geht schnell und ist hier beschrieben: Json verarbeiten. Auf dieser Basis erfolgt auch die Beschreibung an dieser Stelle.

Die Erklärungen erfolgen am Beispiel der abgegbildeten Tabelle mit IDs, Nachnamen und Vornamen. Im ersten Beispiel werden die Spalten A bis C genutzt, im zweiten A bis D.

Für das Verständnis ist ggf. die Gliederung wichtig: Das kleinste Element ist das Paar aus Key und Value. Mehrere dieser (aber zusammengehörigen) Paare werden in einem Dictionary gesammelt. Verschiedene Dictionaries wiederum werden in einer Collection zusammengefasst. Gibt es davon mehrere, werden die in einem Dictionary gebündelt usw. Am Ende habe wir dann die verschiedenen Elemente der obersten Hierarchieebene; in diesen Beispielen sind das die jsonItems, die dann in Json umgewandelt werden.

Hinweis zur Syntax: Ob eine Zuweisung zu einem Element per Element(Key) = Value oder per Element.Add Key, Value erfolgt, ist hier egal. Im ersten Beispiel wird die erste Variante verwendet, im zweiten die zweite.

Eine Ebene

Im ersten Beispiel wollen wir die drei Zeilen als gleichrangige Elemente, die jeweils aus ID, Namen und (erstem) Vornamen bestehen, in eine Json-Struktur bringen. Dazu lassen wir einfach eine Schleife über die drei Zeilen laufen und erzeugen mit jeder Zeile ein Dictionary, hier jsonDictionary, das aus den drei Elementen id, nachname und vorname besteht. Jedes dieser drei Dictionaries weisen wir der Collection jsonItems zu, so dass diese am Ende aus den drei Dictionaries für die einzelnen Zeilen besteht:

For i = 2 To 4 jsonDictionary("id") = Cells(i, 1) jsonDictionary("nachname") = Cells(i, 2) jsonDictionary("vorname") = Cells(i, 3) jsonItems.Add jsonDictionary Set jsonDictionary = Nothing Next i

Nun führen wir zwei Schritte gleichzeitig durch: Wir konvertieren die Collection in das Json-Format und weisen das Ergebnis gleich der Variablen zu, die wir brauchen, um das Ganze per POST an den Server zu schicken. Diese Variable besteht aus einem Key (hier jsonobjekt) und einem Value, der hier der erzeugte Json-Code ist:

strPostDaten = "jsonobjekt=" & JsonConverter.ConvertToJson(jsonItems)

So sieht das dann als String aus, der an den Server geht:

Nun können wir das Ganze losschicken:

With CreateObject("MSXML2.XMLHTTP") .Open "POST", strURL, False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .Send (strPostDaten)

Zur Kontrolle können wir diesen PHP-Code verwenden, der das Json-Objekt in einen Array umwandelt und ausgibt:

$jso = json_decode($_POST['jsonobjekt'], true); $a = print_r($jso, true); echo "Anzahl: " . count($jso) . "\n\n" . $a;

Wenn wir dann in VBA .ResponseText ausgeben lassen, sehen wir das Ergebnis, wie es auf dem Server vorliegt:

Hier der gesamte Code zum Testen:

Sub VBA2JSON() 'PHP: '$jso = json_decode($_POST['jsonobjekt'], true); '$a = print_r($jso, true); 'echo "Anzahl: " . count($jso) . "\n\n" . $a; Dim strURL As String, strPostDaten As String Dim jsonItems As New Collection Dim jsonDictionary As New Dictionary Dim i As LongPtr For i = 2 To 4 jsonDictionary("id") = Cells(i, 1) jsonDictionary("nachname") = Cells(i, 2) jsonDictionary("vorname") = Cells(i, 3) jsonItems.Add jsonDictionary Set jsonDictionary = Nothing Next i strPostDaten = "jsonobjekt=" & JsonConverter.ConvertToJson(jsonItems, 3) strURL = "https://example.org/vba2json.php" With CreateObject("MSXML2.XMLHTTP") .Open "POST", strURL, False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .Send (strPostDaten) If .ResponseText <> "" Then MsgBox .ResponseText Else MsgBox "Schiefgegangen.", vbOKOnly + vbCritical, "Fehler" End If End With End Sub

 

Verschachtelungen, mehrere Ebenen

Das Vorgehen bei mehreren Levels, also Ebenen, ist genau das gleiche. Die Besonderheit besteht nur darin, dass dem Dictionary beim Key=Value-Paar dem Key statt eines z. B. Strings eine Collection zugewiesen wird, also Key=Collection. Dieser Collection werden vorher die einzelnen Dictionary-Einträge mitgegeben, also die Key=Value-Paare der tieferen Ebene.

Wir verwenden das gleiche Beispiel wie vorher, nur dass die jeweils beiden Vornamen gesammelt in einem Array unter "vorname" eine Ebene tiefer sein sollen:

Dafür müssen wir nur die Zeile ändern, in der dem jsonDictionary bisher der Vorname zugewiesen wurde. Dafür legen wir ein neues Dictionary an, hier dicVorname. Dem weisen wir die beiden Key-Value-Paare zu (Hinweis: zum Verdeutlichen wurde hier die .Add-Schreibweise verwendet). Daraus erstellen wir dann die Collection colVornamen. Fertig ist der Value für die erste Ebene, dort weisen wir den dem Dictionary jsonDictionary zum Key vorname zu.

Der Rest bleibt. Mit PHP können wir .ResponseText wieder ansehen:

$jso = json_decode($_POST['jsonobjekt'], true); $a = print_r($jso, true); echo $a;

Oder etwas komprimierter, indem wir den Array analysieren:

$jso = json_decode($_POST['jsonobjekt'], true); foreach ($jso as $key => $value) { foreach ($value as $key1 => $value1) { if ($key1 == "vorname") { $jso1 = $value1; foreach ($jso1[0] as $key_v => $value_v) { echo $key . " => " . $key_v . ": " . $value_v . "\n"; } } else { echo $key . " => " . $key1 . ": " . $value1 . "\n"; } } echo "\n-----------------------------------\n"; }

Der gesamte Code zum Testen:

Sub VBA2JSON_Level() 'PHP: '$jso = json_decode($_POST['jsonobjekt'], true); '$a = print_r($jso, true); 'echo $a; 'Oder: '$jso = json_decode($_POST['jsonobjekt'], true); 'foreach ($jso as $key => $value) { ' foreach ($value as $key1 => $value1) { ' ' if ($key1 == "vorname") { ' $jso1 = $value1; ' foreach ($jso1[0] as $key_v => $value_v) { ' echo $key . " => " . $key_v . ": " . $value_v . "\n"; ' } ' } else { ' echo $key . " => " . $key1 . ": " . $value1 . "\n"; ' } ' ' } ' echo "\n-----------------------------------\n"; '} Dim strURL As String, strPostDaten As String Dim jsonItems As New Collection, colVornamen As New Collection Dim jsonDictionary As New Dictionary, dicVorname As Dictionary Dim i As LongPtr For i = 2 To 4 jsonDictionary.Add "id", Cells(i, 1) jsonDictionary.Add "nachname", Cells(i, 2) Set dicVorname = New Dictionary dicVorname.Add "vorname1", Cells(i, 3) dicVorname.Add "vorname2", Cells(i, 4) colVornamen.Add dicVorname jsonDictionary.Add "vorname", colVornamen Set colVornamen = Nothing jsonItems.Add jsonDictionary Set jsonDictionary = Nothing Next i strPostDaten = "jsonobjekt=" & JsonConverter.ConvertToJson(jsonItems) strURL = "https://example.org/vba2json.php" With CreateObject("MSXML2.XMLHTTP") .Open "POST", strURL, False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .Send (strPostDaten) If .ResponseText <> "" Then MsgBox .ResponseText Else MsgBox "Schiefgegangen.", vbOKOnly + vbCritical, "Fehler" End If End With End Sub

Download: excel_php_json.xlsm

Numerische und alphanumerische Werte sortieren (mit Regex)Makro/Sub/ProzedurUDF - benutzerdefinierte Funktion

Kategorien: Filter/Sortieren und Stringoperationen ▸ Teile

(Tipp 140) Beispieldatei Nachricht zum Beitrag an Autor Nach oben

Wie kann ich folgende Zahlen in Spalte A sortieren: 100, 101, 100a, 100b, 102? Dazwischen befinden sich keine leeren Zellen.

Hinweis:
Dieser Artikel zeigt gleichzeitig Möglichkeiten zur Arbeit mit benutzerdefinierten Funktionen (Datenfeld als Rückgabewert bzw. Ergebnis), mehrdimensionalen Arrays, regulären Ausdrücken (regular Expressions), verschiedenen Schleifen und mehr.

Variante 1

Die erste Variante hält sich genau an die Aufgabenstellung, dass also an einer führenden Ganzzahl genau ein Buchstabe sein darf. Dazwischen darf sich keine Leerstelle befinden.

Es wird eine Schleife über alle Zellen so lange durchlaufen, bis die Daten tatsächlich sortiert sind, bolSortiert also nicht mehr False wird.

In der Schleife werden aus der gerade durchlaufenen Zeile und aus der nächsten Zeile die Zahlen extrahiert, aus 100b also die 100. Diese Zahlen werden den Variablen c und d zugewiesen.

Im nächsten Schritt wird geprüft, ob die folgende Zahl kleiner als die aktuelle ist. Wenn ja, werden die beiden Zellinhalte getauscht, so dass die kleinere Zahl zuerst steht.

Sind die Zahlen jedoch gleich, wie es bei 100a und 100b der Fall ist, wird geprüft, ob die rechte Stelle (Right(b, 1)) der nächsten Zeile kleiner als die der aktuellen Zeile ist. Zum Beispiel ist das a in 100a kleiner als das b in 100b. Wenn ja, werden die Zellen getauscht.

In beiden ja-Fällen wird die Variable bolSortiert auf False gesetzt, so dass die Do-Loop-Schleife weiß, dass sie von vorn beginnen, also die For-Schleife über die Zellen neu starten soll.

Sub SortierenEinfach() Dim lngEZ As Long, lngLZ As Long, intS As Integer, lngI As Long Dim a, b, c, d Dim bolSortiert As Boolean lngEZ = 1 'erste Zeile - anpassen! intS = 1 'Spalte A lngLZ = Cells(Rows.Count, intS).End(xlUp).Row Do bolSortiert = True For lngI = lngEZ To lngLZ - 1 a = Cells(lngI, intS) b = Cells(lngI + 1, intS) If IsNumeric(a) = False Then If a <> "" Then c = Left(a, Len(a) - 1) Else c = 0 Else: c = a End If If IsNumeric(b) = False Then If b <> "" Then d = Left(b, Len(b) - 1) Else d = 0 Else: d = b End If If CInt(d) < CInt(c) Then Cells(lngI, intS) = b Cells(lngI + 1, intS) = a bolSortiert = False ElseIf CInt(c) = CInt(d) Then If Right(b, 1) < Right(a, 1) Then Cells(lngI, intS) = b Cells(lngI + 1, intS) = a bolSortiert = False End If End If Next Loop While bolSortiert = False End Sub


Erweiterte Variante mit benutzerdefinierter Funktion (UDF)

Was nun aber, wenn man nicht voraussetzen kann, dass die Syntax dem Schema entspricht? Wenn es zum Beispiel Leerstellen zwischen Zahl und Buchstaben oder mehrere Buchstaben geben kann? Oder vielleicht sogar negative Zahlen?

In dem Fall versagt die erste Variante.

Für diese Eventualitäten müssen wir den String aus Zahl und Text besser aufteilen. Mit Right(String, 1) geht es nicht, da wir damit immer nur den letzten Buchstaben erwischen würden. Split ist auch nicht möglich, da wir kein Trennzeichen haben und der Split auf "" den kompletten String zurückgibt. Also müssen wir das selbst machen.

Da das etwas länger wird und wir den Code zum Extrahieren der Zahl zweimal brauchen, er also zweimal in der Scheife vorkommen würde, schreiben wir dazu eine Funktion, der wir den kompletten String aus Zahl und möglichen Buchstaben übergeben. Als Ergebnis erhalten wir ein Datenfeld aus zwei Elementen. Im ersten steht die extrahierte Zahl oder 0, wenn keine Zahl im String entalten ist. Im zweiten Element steht die Buchstabenfolge vom Schluss des Originalstrings oder "", wenn es keine Buchstaben gibt.

Die beiden Elemente werden vorbelegt, so dass später nur die Änderungen übergeben werden müssen. Zu sehen ist, dass als Zahl erkannt wird, wenn es sich um eine Zahl, ein Komma oder ein Minus handelt. Bei Bedarf kann das natürlich angepasst werden. Wichtig ist, dass die Zahlen-Zeichenfolge nicht mehr erweitert wird, wenn einmal ein anderes Zeichen erkannt wurde. Deshalb (und falls mal keine Ziffer am Anfang steht) wurde bolZahl = True gesetzt. Sobald im String kein Zahlzeichen (Ziffer, Komma, Minus) gefunden wird, ist diese Variable False und es wird alles dem Buchstabenstring zugeordnet - auch, wenn später im String noch eine Ziffer kommen sollte.

Damit der Zahlenstring später als Zahl erkannt wird, wird einfach mit 1 multiplizert, um etwas zu berechnen. Man kann das natürlich auch an eine extra dafür deklarierte Variable übergeben.

Das ist die Funktion:

Function StringSplit(ByVal varWert As Variant) Dim arrErgeb(1 To 2) Dim strZahl As String, strString As String, bolZahl As Boolean Dim intN As Integer arrErgeb(1) = 0 'vorbelegen, später werden nur Änderungen übergeben arrErgeb(2) = "" If IsNumeric(varWert) Then arrErgeb(1) = varWert * 1 Else strZahl = "": strString = "": bolZahl = False For intN = 1 To Len(varWert) If IsNumeric(Mid(varWert, intN, 1)) Or Mid(varWert, intN, 1) = "," Or Mid(varWert, intN, 1) = "-" Then If strString = "" Then strZahl = strZahl & Mid(varWert, intN, 1) bolZahl = True Else If intN = 1 Then bolZahl = True If bolZahl Then strString = strString & Mid(varWert, intN, 1) End If Next arrErgeb(1) = IIf(strZahl = "", 0, strZahl * 1) arrErgeb(2) = Trim(strString) End If StringSplit = arrErgeb End Function

Die eigentliche Routine zum Sortieren ist dann vom Aufbau her wie die vorige, nur dass anstelle der Variablen c und d die Rückgaben aus der Funktion stehen:

Sub SortierenAlphaNum() Dim lngEZ As LongPtr, lngLZ As LongPtr, intS As Integer, lngZ As LongPtr Dim a, b Dim bolSortiert As Boolean Dim arrA(), arrB() lngEZ = 1 'erste Zeile - anpassen! intS = 1 'Spalte A lngLZ = Cells(Rows.Count, intS).End(xlUp).Row Do bolSortiert = True For lngZ = lngEZ To lngLZ - 1 a = Cells(lngZ, intS) b = Cells(lngZ + 1, intS) arrA = StringSplit(Cells(lngZ, intS)) arrB = StringSplit(Cells(lngZ + 1, intS)) 'die nächste Zahl ist kleiner als die aktuelle: If arrB(1) < arrA(1) Then Cells(lngZ, intS) = b Cells(lngZ + 1, intS) = a bolSortiert = False 'nächste Zahl ist wie die aktuelle, mögliche Strings prüfen ElseIf arrA(1) = arrB(1) Then If arrB(2) < arrA(2) Then Cells(lngZ, intS) = b Cells(lngZ + 1, intS) = a bolSortiert = False End If End If 'Falls Datensätze im Spiel sind und die Daten sortiert werden sollen, 'können die folgenden Zeilen die Nummern gesplittet in die Nachbarzellen 'schreiben, um dann danach zu sortieren: Cells(lngZ, intS + 1) = arrA(1) Cells(lngZ, intS + 2) = arrA(2) If lngZ = lngLZ - 1 Then Cells(lngZ + 1, intS + 1) = arrB(1) Cells(lngZ + 1, intS + 2) = arrB(2) End If Next Loop While bolSortiert = False End Sub


Microsoft VBScript Regular Expressions

Variante mit regulären Ausdrücken/Regular Expressions

Das mit der Funktion ist zu lang? Kein Problem, es geht auch kürzer. Wenn im VB-Projekt ein Verweis zu Microsoft VBScript Regular Expressions gesetzt wird, können wir reguläre Ausdrücke verwenden.

Das Suchmuster wäre in diesem Fall:

regex.Pattern = "^([-0-9,]+)([ a-zA-Z0-9]*)$"

Das heißt, am Anfang des Strings mit Zahl und Buchstaben muss eins der Zeichen von 0 bis 9, ein Minus oder ein Komma wenigstens einmal (deshalb das +) stehen. Dahinter kann (deshalb das *) eine Kombination aus Leerzeichen, Buchstaben und weiteren Ziffern folgen. Diese beiden Teile stehen in runden Klammern und werden dann an die Variablen arrA und arrB übergeben, wenn Matches gefunden wurden. Im jeweils ersten Element (arrA(1) und arrB(1) ) der Variablen stehen wieder die Zahlen, die - damit sie nicht als Text erkannt werden - mit 1 multipliziert werden.

Der Rest ist dann so wie bei den anderen beiden Varianten.

Sub SortierenAlphaNumRegex() Dim regex As New RegExp Dim regMatches As MatchCollection, regMatch As Match Dim lngEZ As LongPtr, lngLZ As LongPtr, intS As Integer, lngZ As LongPtr Dim a, b Dim bolSortiert As Boolean Dim arrA(1 To 2), arrB(1 To 2) lngEZ = 1 'erste Zeile - anpassen! intS = 1 'Spalte A lngLZ = Cells(Rows.Count, intS).End(xlUp).Row regex.Pattern = "^([-0-9,]+)([ a-zA-Z0-9]*)$" Do bolSortiert = True For lngZ = lngEZ To lngLZ - 1 a = Cells(lngZ, intS) arrA(1) = 0: arrA(2) = "" Set regMatches = regex.Execute(Cells(lngZ, intS)) If regMatches.Count > 0 Then arrA(1) = regMatches(0).SubMatches(0) * 1 arrA(2) = regMatches(0).SubMatches(1) End If b = Cells(lngZ + 1, intS) arrB(1) = 0: arrB(2) = "" Set regMatches = regex.Execute(Cells(lngZ + 1, intS)) If regMatches.Count > 0 Then arrB(1) = regMatches(0).SubMatches(0) * 1 arrB(2) = regMatches(0).SubMatches(1) End If 'die nächste Zahl ist kleiner als die aktuelle: If arrB(1) < arrA(1) Then Cells(lngZ, intS) = b Cells(lngZ + 1, intS) = a bolSortiert = False 'nächste Zahl ist wie die aktuelle, mögliche Strings prüfen ElseIf arrA(1) = arrB(1) Then If arrB(2) < arrA(2) Then Cells(lngZ, intS) = b Cells(lngZ + 1, intS) = a bolSortiert = False End If End If 'Falls Datensätze im Spiel sind und die Daten sortiert werden sollen, 'können die folgenden Zeilen die Nummern gesplittet in die Nachbarzellen 'schreiben, um dann danach zu sortieren: Cells(lngZ, intS + 1) = arrA(1) Cells(lngZ, intS + 2) = arrA(2) If lngZ = lngLZ - 1 Then Cells(lngZ + 1, intS + 1) = arrB(1) Cells(lngZ + 1, intS + 2) = arrB(2) End If Next Loop While bolSortiert = False End Sub


Beschleunigen: Sortieren per Array

Schnell wird man feststellen, dass die Laufzeit bei solchen Routinen sehr lang werden kann. Die Ursache liegt hier jedoch weniger bei den Schleifen, sondern eher darin, dass immer wieder Lese- und Schreibzugriffe auf die Zellen erfolgen. Das bremst die Schleifen aus.

Nun könnten wir mit Application.ScreenUpdating = False die Bildschirmaktualisierung ausschalten. Das würde tatsächlich ein paar Zehntelsekunden bringen, vielleicht auch Sekunden. Schneller geht es jedoch, wenn wir für den eigentlich Sortiervorgang gar nicht auf die Zellen zugreifen.

Dazu lesen wir alle Zellen zunächst in einen Array ein:

Dim arrSamm(), arrTemp lngEZ = 1 'erste Zeile - anpassen! intS = 1 'Spalte A lngLZ = Cells(Rows.Count, intS).End(xlUp).Row ReDim Preserve arrSamm(1 To 2, lngEZ To lngLZ) For lngZ = lngEZ To lngLZ arrSamm(1, lngZ) = Cells(lngZ, intS) Next

arrSamm() hat hier zwei Spalten (1 To 2), obwohl nur eine reichen würde. Die zweite Spalte wird in diesem Beispiel nur die aufgesplitteten Strings, also die Zahlen und die Buchstaben, zur späteren Ausgabe aufnehmen - diese jeweils als Datenfelder. In der ersten SDpalte von arrSamm() werden also die zu sortierenden Strings stehen, in der zweiten die getrennten Daten.

Sind die Daten im Array, führen wir dort den Sortiervorgang durch. Das Prinzip ist genau das der bisherigen Varianten, nur eben nicht an Zellen.

Erst ganz zum Schluss schreiben wir den - nun sortierten - Array wieder in die Zellen:

For lngZ = lngEZ To lngLZ Cells(lngZ, 1) = arrSamm(1, lngZ) arrTemp = arrSamm(2, lngZ) Cells(lngZ, 2) = arrTemp(1) Cells(lngZ, 3) = arrTemp(2) Next

Die Routine als Ganzes:

Sub SortierenAlphaNumRegexArray() Dim Regex As New RegExp Dim regMatches As MatchCollection, regMatch As Match Dim lngEZ As LongPtr, lngLZ As LongPtr, intS As Integer, lngZ As LongPtr Dim a, b Dim bolSortiert As Boolean Dim arrA(1 To 2), arrB(1 To 2) Dim arrSamm(), arrTemp lngEZ = 1 'erste Zeile - anpassen! intS = 1 'Spalte A lngLZ = Cells(Rows.Count, intS).End(xlUp).Row ReDim Preserve arrSamm(1 To 2, lngEZ To lngLZ) For lngZ = lngEZ To lngLZ arrSamm(1, lngZ) = Cells(lngZ, intS) Next Regex.Pattern = "^([-0-9,]+)([ a-zA-Z0-9]*)$" Do bolSortiert = True For lngZ = lngEZ To lngLZ - 1 a = arrSamm(1, lngZ) arrA(1) = 0: arrA(2) = "" Set regMatches = Regex.Execute(a) If regMatches.Count > 0 Then arrA(1) = regMatches(0).SubMatches(0) * 1 arrA(2) = regMatches(0).SubMatches(1) arrSamm(2, lngZ) = arrA 'für die spätere Ausgabe in den Nachbarzellen End If b = arrSamm(1, lngZ + 1) arrB(1) = 0: arrB(2) = "" Set regMatches = Regex.Execute(b) If regMatches.Count > 0 Then arrB(1) = regMatches(0).SubMatches(0) * 1 arrB(2) = regMatches(0).SubMatches(1) arrSamm(2, lngZ + 1) = arrB 'für die spätere Ausgabe in den Nachbarzellen End If If arrB(1) < arrA(1) Then 'die nächste Zahl ist kleiner als die aktuelle: arrSamm(1, lngZ) = b: arrSamm(2, lngZ) = arrB arrSamm(1, lngZ + 1) = a: arrSamm(2, lngZ + 1) = arrA bolSortiert = False ElseIf arrA(1) = arrB(1) Then 'nächste Zahl ist wie die aktuelle, mögliche Strings prüfen If arrB(2) < arrA(2) Then arrSamm(1, lngZ) = b: arrSamm(2, lngZ) = arrB arrSamm(1, lngZ + 1) = a: arrSamm(2, lngZ + 1) = arrA bolSortiert = False End If End If Next Loop While bolSortiert = False For lngZ = lngEZ To lngLZ 'Ausgabe Cells(lngZ, 1) = arrSamm(1, lngZ) arrTemp = arrSamm(2, lngZ) Cells(lngZ, 2) = arrTemp(1) Cells(lngZ, 3) = arrTemp(2) Next End Sub

Und schon benötigt das Ganze nur noch einen Bruchteil der bisherigen Laufzeit.


Beispieldatei

Diese Beispiele sind in der Beispieldatei enthalten: alphanum_sort.xlsm.

Beachten Sie aber, dass die Routine SortierenEinfach() bei den erweiterten Daten eine Fehlermeldung bringt, denn diese Routine funktioniert nur auf der Basis der in der Aufgabenstellung vorgegebenen Syntax der Daten ZahlBuchstabe. In der Fehlermeldung wird auch angezeigt, an welchem String diese Routine scheitert.

Im Beispiel ist das Problem der Vergleich der Zeile 5 (103b) mit der nächsten Zeile (,55aaa). Die Syntax mit vorangestelltem Komma (was in Excel durchaus möglich ist) und mehreren Buchstaben nach der Zahl kann diese einfache Routine nicht. Die anderen kommen damit klar.

Download: alphanum_sort.xlsm



String aufteilenUDF - benutzerdefinierte Funktion

Kategorie: Stringoperationen ▸ Teile

(Tipp 567) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich einen String aufgrund eines Trennzeichens aufteilen?

Split()

Die folgende Funktion splittet den String am Trenner und gibt - wenn vorhanden - das Element intWelcher zurück:

Function SplitString(strString, intWelcher, strTrenner) Dim arrTemp SplitString = "" arrTemp = Split(strString, strTrenner) If UBound(arrTemp) >= intWelcher - 1 Then SplitString = arrTemp(intWelcher - 1) End Function

Eingesetzt wird sie so: MsgBox SplitString("abc;cde;890;321", 3, ";"). Oder als Formel in eine Zelle.


Array, implizite Schnittmenge, impliziter Schnittpunktoperator @

Ab Excel 365 ist es auch möglich, die aufgeteilte Zeichenfolge insgesamt ausgeben zu lassen. Für das Beispiel die folgende Funktion:

Function Stringteile(strString, strTrenner) Dim arrTemp arrTemp = Split(strString, strTrenner) Stringteile = IIf(UBound(arrTemp) > 0, arrTemp, "") End Function

In Zelle B1 steht der String Januar;Februar;März, in C1 steht die Formel =Stringteile(B1;";"). Die Monate werden durch die Funktion also am Semikolon gesplittet und die Funktion gibt das Ganze als Array zurück. Da es sich aber um drei Elemente handelt (eben die drei Monate), werden diese auf die Nachbarzellen ausgeweitet; die Zelle mit der Formel fließt über.

Wird jedoch der implizite Schnittpunktoperator @ verwendet (also =@Stringteile(B1;";")), wird nur das erste Element des Arrays zurückgegeben, also der Januar.

In jedem Fall kann aus einer anderen Formel heraus Bezug auf eine Ergebniszelle genommen werden. Im Beispiel auch auf E1, wo das Element März steht.


Für sehr alte Excelversionen

Die hier dargestellte Funktion stellt eine Alternative zur Funktion Split() dar, die es in niedrigeren Excelversionen noch nicht gab. Alternativ kann die Funktion auch als Tabellenblattfunktion verwendet werden, wenn man Daten - Text in Spalten nicht verwenden kann.

An die Funktion wird übergeben, welcher String aufgeteilt werden soll (strString), der wievielte Eintrag zurückgegeben werden soll (intWelcher) und um welches Trennzeichen es sich handelt (strTrenner).

Function SemiTrenner(strString, intWelcher, strTrenner) Dim intI As Integer Dim intZaehler As Integer Dim intBeginn As Integer, intEnde As Integer intBeginn = 0 intEnde = 0 intZaehler = 1 If Right(strString, 1) <> strTrenner Then strString = strString & strTrenner For intI = 1 To Len(strString) + 2 If Mid(strString, intI, 1) = strTrenner Then If intZaehler = 1 And intWelcher = 1 Then intBeginn = 1 intEnde = intI Exit For ElseIf intZaehler = intWelcher Then intBeginn = intEnde + 1 intEnde = intI Exit For End If intZaehler = intZaehler + 1 intEnde = intI End If Next If intBeginn > 0 And intEnde > 0 Then SemiTrenner = Mid(strString, intBeginn, intEnde - intBeginn) Else SemiTrenner = "" End Function

So könnte die Funktion wie folgt eingesetzt werden:

strString = "1;456;78,9bb;543;" MsgBox SemiTrenner(strString, 3, ";")

Das Ergebnis wäre in diesem Fall 78,9bb.

Textdatei erstellen und Text wieder in Excel einlesenMakro/Sub/ProzedurUDF - benutzerdefinierte FunktionArrayfunktion/Matrixfunktion

Kategorie: Dateien und Ordner ▸ Dateioperation

(Tipp 33) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich aus einem Tabellenbereich eine Textdatei erstellen und diese Textdatei wieder in Excel einlesen?

In Spalte A wird solange gesucht, bis eine leere Zelle gefunden wird. Natürlich wäre auch eine For-Schleife mit Application.Cells(Rows.Count, 1).End(xlUp).Row möglich.

Die Daten aus A, B und C werden mit einem Semikolon als Trennzeichen in eine Textdatei eingelesen.

Einlesen in eine Textdatei mit immer gleichem Pfad:

Sub AlsTextSpeichern() Dim intI As Integer, lngDNr As LongPtr lngDNr = FreeFile 'Pfad anpassen Open "C:\Eigene Dateien\aus Tabelle.txt" For Output As #lngDNr intI = 2 'erste Zeile mit Angaben Do While Cells(intI, 1).Value <> "" 'Schleife, solange die Zelle nicht leer ist 'Übernehmen der Daten in die Textdatei Print #lngDNr, Cells(intI, 1) & ";" & Cells(intI, 2) & ";" & Cells(intI, 3) intI = intI + 1 Loop Close #lngDNr End Sub

Einlesen in eine Textdatei mit wählbarem Pfad:

Sub AlsTextSpeichern1() Dim intI As Integer, lngDNr As LongPtr Dim varPfad varPfad = Application.GetSaveAsFilename(InitialFileName:="Test", fileFilter:="Textdateien (*.txt), *.txt") If varPfad = False Then Exit Sub lngDNr = FreeFile Open varPfad For Output As #lngDNr intI = 2 Do While Cells(intI, 1).Value <> "" Print #lngDNr, Cells(intI, 1) & ";" & Cells(intI, 2) & ";" & Cells(intI, 3) intI = intI + 1 Loop Close #lngDNr End Sub

Textdatei in Exceldatei einlesen, immer gleicher Pfad:

Da das Semikolon als Trennzeichen verwendet wurde, brauchen wir die Textdatei als solche nicht aus- und in Excel einzulesen, sondern wir können die Datei direkt öffnen:

Sub AusTextAufrufen() On Error Resume Next 'falls Datei nicht existiert 'hier nur den Pfad ändern Workbooks.OpenText Filename:="C:\Eigene Dateien\aus Tabelle.txt", DataType:=xlDelimited, semicolon:=True End Sub

Textdatei in Exceldatei einlesen, wählbarer Pfad:

Sub AusTextAufrufen1() Dim varPfad varPfad = Application.GetOpenFilename(fileFilter:="Textdateien (*.txt), *.txt") If varPfad = False Then Exit Sub Workbooks.OpenText Filename:=varPfad, DataType:=xlDelimited, semicolon:=True End Sub

Gibt es andere Trennzeichen, erfolgt das Aufteilen auf die Zellen natürlich nicht unbedingt. Dann kann entweder mit Split() gearbeitet werden oder es kann mit der integrierten Methode Text in Spalten aufgeteilt werden.


Dynamische Arrayformel mit Matrixfunktion

Möglich ist natürlich auch ab Excel 365, die Textdatei mittels benutzerdefinierter Matrixfunktion auszulesen und die Ergebnisse als Array zu übergeben:

Function DateiEinlesen(strDatei, strTrenner, intSpalten) Dim intS As Integer, lngZ As LongPtr Dim lngDNr As Long, strZeile As String, arrTemp Dim arrS() lngDNr = FreeFile lngZ = 0 Open strDatei For Input As #lngDNr Do While Not EOF(lngDNr) Line Input #lngDNr, strZeile If strZeile <> "" Then arrTemp = Split(strZeile, strTrenner) lngZ = lngZ + 1 ReDim Preserve arrS(1 To intSpalten, 1 To lngZ) For intS = 1 To intSpalten If UBound(arrTemp) >= intS Then arrS(intS, lngZ) = arrTemp(intS) Else arrS(intS, lngZ) = "" End If Next End If Loop Close #lngDNr DateiEinlesen = Application.WorksheetFunction.Transpose(arrS) End Function

In die Zelle kommt dann nur noch die Formel:

=DateiEinlesen(Pfad zur Datei;Trennzeichen;Anzahl der Spalten)

=DateiEinlesen(A1;";";4)

Allerdings sollten die Dateien natürlich nicht zu groß sein, weil die Berechnung dieser Formel sonst alles verzögern würde.

Vornamen und Nachnamen trennenMakro/Sub/ProzedurUDF - benutzerdefinierte FunktionTipp

Kategorie: Stringoperationen ▸ Teile

(Tipp 124) Nachricht zum Beitrag an Autor Nach oben

In einem markierten Bereich befinden sich in jeweils einer Zelle Vornamen und Nachnamen, die durch Leerstellen getrennt sind. Wie kann ich Vornamen und Nachnamen in die Nachbarzellen einlesen lassen?

Hier wird an den Leerzeichen getrennt, ggf. müssen noch weitere Schreibweisen beachtet werden.

Schleife über die Zellen

Variante 1:

Sub Namen_trennen() Dim rngZelle As Range Dim intS As Integer Dim strV As String Dim arrTemp 'Bereich muß markiert sein, für jede Zelle in der Markierung: For Each Zelle In Selection With Zelle If .Value <> "" Then arrTemp = Split(.Value, " ") Select Case UBound(arrTemp) Case 0: Cells(.Row, .Column + 1) = .Value Case Else strV = "" For intS = 0 To UBound(arrTemp) - 1 strV = strV & IIf(strV <> "", " ", "") & arrTemp(intS) Next Cells(.Row, .Column + 1) = strV Cells(.Row, .Column + 2) = arrTemp(UBound(arrTemp)) End Select End If End With Next End Sub

Variante 2:

Sub Namen_trennen1() Dim intA As Integer, intB As Integer, intI As Integer Dim Zelle As Object 'Bereich muß markiert sein, 'für jede Zelle in der Markierung: For Each Zelle In Selection With Zelle If .Value <> "" Then 'Suche nach der ersten Leerstelle intA = InStr(.Value, " ") 'Schleife, falls mehrere durch leer getrennte Vornamen 'vorhanden sind, z. B. Ute Elke Meier For intI = 0 To Len(.Value) intB = InStr(Right(.Value, Len(.Value) - intA), " ") intA = InStr(Right(.Value, Len(.Value) - intA), " ") + intA Next 'Aufteilen auf die 1. Zelle rechts und die 2. Zelle rechts 'Vorname Cells(.Row, .Column + 1).Value = Left(.Value, intA - 1) 'Name Cells(.Row, .Column + 2).Value = Right(.Value, Len(.Value) - intA) End If End With Next End Sub

Text in Spalten

Variante 3:

Sub Namen_trennen2() Dim lngZeile As Long, lngSpalte As Long, strZiel As String lngZeile = ActiveCell.Row: lngSpalte = ActiveCell.Column strZiel = Cells(lngZeile, lngSpalte + 2).Address Selection.TextToColumns Destination:=Range(strZiel), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, _ FieldInfo:=Array(Array(1, 1), Array(2, 1)) End Sub

Es ist mit dieser Methode auch möglich, mehr als 2 Wörter, die mit Leerzeichen getrennt sind, in die Nachbarzellen zu übertragen. Sollten in nebenstehenden Zellen Daten stehen, muss man vor der Ausführung des Befehls darauf achten, entsprechend viele Spalten einzufügen.


Dynamische Arrayformel mit Matrixfunktion

Je nach Situation kann auch eine Arrayformel in Betracht gezogen werden:

Function NamenTrennen(ByVal strName As String, Optional intAnzahl As Integer = 5) Dim arrTemp, intS As Integer ReDim arrNamen(1 To intAnzahl) NamenTrennen = "" For intS = 1 To intAnzahl arrNamen(intS) = "" Next If strName <> "" Then arrTemp = Split(strName, " ") For intS = 0 To UBound(arrTemp) If intS < intAnzahl Then arrNamen(intS + 1) = arrTemp(intS) Next End If NamenTrennen = arrNamen End Function

In die Zelle kommt dazu diese überlaufende Formel:

=NamenTrennen(A1)

Da die Anzahl der Namensteile variieren kann, ein Array aber (in diesem Fall) immer gleich breit ist, ist eine Breite von fünf Zellen voreingetragen. Der Array wird dabei von links gefüllt, so dass die einzelnen Teile in der linken Zelle beginnen. Mit einem zweiten Parameter in der Funktion kann diese Breite geändert werden, zum Beispiel auf vier Zellen Breite:

=NamenTrennen(A1;4)

Besteht der Name dann aus mehr Teilen, werden die restlichen rechten Teile nicht angezeigt.

Zelleinträge trennenTipp

Kategorie: Stringoperationen ▸ Teile

(Tipp 244) Nachricht zum Beitrag an Autor Nach oben

In einem Zellbereich stehen in den einzelnen Zellen Vor und Nachnamen. Wie kann ich diese Einträge ohne VBA trennen, so dass in einer Zelle der Vor- und in der Nachbarzelle der Nachname erscheint?

Zunächst sollte man hinter der Spalte, welche die Daten (also Vor- und Nachname) enthält, eine neue Spalte einfügen. Danach ist folgendes Vorgehen möglich:

  1. Entsprechenden Bereich (oder auch die gesamte Spalte) markieren.
  2. Ribbon Daten aufrufen.
  3. Eintrag Text in Spalten wählen, ein Assistent wird gestartet.
  4. Der Eintrag Getrennt muss aktiviert sein.
  5. Mit der Schaltfläche Weiter gelangt man in den zweiten Schritt des Assistenten.
  6. Leerzeichen wählen.
  7. Mit der Schaltfläche Weiter erhält man eine Vorschau.
  8. Mit Fertigstellen die Aktion beenden.

Es ist mit dieser Methode auch möglich, mehr als 2 Wörter, die mit Leerzeichen getrennt sind, in die Nachbarzellen zu übertragen. Sollten in nebenstehenden Zellen Daten stehen, muss man darauf achten, vor der Ausführung des Befehls entsprechend viele Spalten einzufügen.