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!

Application-EreignisseMakro/Sub/ProzedurTipp

Kategorien: Basics ▸ Ereignisse und Ereignisse ▸ Basics

(Tipp 97) Nachricht zum Beitrag an Autor Nach oben

Application-Ereignisse gelten für die gesamte Anwendung, für alle Fenster, Arbeitsmappen und Tabellenblätter. Um mit Ereignissen des Application-Objekts zu arbeiten, muß man zuvor eine öffentliche Variable der Objektklasse in einem Klassenmodul definieren und danach ein Objekt der neuen Klasse und darin wieder ein Objekt der Klasse. Letzteres wird wiederum in einem einfachen Modul erstellt.

Was sich zunächst ein wenig kompliziert anhört, ist im Grunde recht einfach zu verwirklichen.

  1. Man wechselt in den Visual-Basic-Editor und geht auf Einfügen/Klassenmodul. Das Klassenmodul trägt den Namen Klasse1. Diesen wechselt man unter Eigenschaften/Namen in Anwendungsklasse. Dies bietet später eine bessere Übersicht, sollte man noch weitere Klassen definieren.
  2. Die öffentliche Variable wird definiert. Dazu gibt man folgenden Code ein: Public WithEvents Anwendung As Application. Danach stehen schon die Application-Ereignisse im rechten Listenfeld zur Verfügung. Diese erhält man, wenn man im linken Listenfeld auf "Anwendung" wechselt.
  3. Nun wird ein Objekt der neuen Klasse definiert. Dies geschieht in einem allgemeinen Modul (Einfügen/Modul): Dim Anwendungsobjekt As New Anwendungsklasse.
  4. Nun wird unter der Deklaration des Objekts "Anwendungsobjekt" eine Prozedur erstellt, die der Variablen Anwendung der Anwendungsklasse einen Verweis auf das Anwendungsobjekt zuweist:

Sub ObjektZuordnen() Set Anwendungsobjekt.Anwendung = Application End Sub

Ab sofort können alle Ereignisse des Application-Objektes empfangen werden, wenn diese Routine ausgeführt wurde. Damit das neue Objekt immer zur Verfügung steht, sollte der letzte Code in Workbook_Open() der Mappe.

Wir können nun zum Besipiel jeden Blattwechsel in jeder offenen Mappe abfangen (also nicht nur in der mit dem Code), indem wir in das Klassenmodul eintragen:

Private Sub Anwendung_SheetActivate(ByVal Sh As Object) MsgBox Sh.Name End Sub

Hinweis:
Um Application-Ereignisse zu deaktivieren, setzt man einfach den Verweis auf das "Anwendungsobjekt" auf Nothing, also Set Anwendungsobjekt.Anwendung = Nothing

Parameter:

Die Application-Ereignisse haben feste Parameter, die mit übergeben werden (im vorigen Code-Beispiel ist das schon an ByVal Sh As Object zu sehen):

Wb:Stellt die aktive Arbeitsmappe dar.
Sh:Steht für das aktive Tabellenblatt.
Target:Bezieht sich auf den aktiven Zellenbereich.
Cancel:Hat den Wert False. Wird er in der Ereignisprozedur (z. B. bei BeforeSave) auf True gesetzt, wird das Ereignis nicht ausgeführt, sprich es wird nicht gespeichert. U. a. lässt sich so auch gut das Schließen einer Mappe abfangen.

Ereignisse:

Am einfachsten wählt man die natürlich über das Dropdown im Klassenmodul, wie es in der obigen Abbildung dargestellt ist. Hier eine kleine Übersicht:

Anwendung_NewWorkbook(ByVal Wb As Excel.Workbook)
Eine neue Arbeitsmappe wurde eingefügt.
Anwendung_SheetActivate(ByVal Sh As Object)
Ein anderes Blatt wurde aktiviert (Blattwechsel).
Anwendung_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
Doppelklick wurde ausgeführt.
Anwendung_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
Klick mit der rechten Maustaste.
Anwendung_SheetCalculate(ByVal Sh As Object)
Neuberechnung eines Tabellenblattes.
Anwendung_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Zelleninhalt eines Tabellenblattes wurde verändert.
Anwendung_SheetDeactivate(ByVal Sh As Object)
Ein Tabellenblatt wurde verlassen (Blattwechsel).
Anwendung_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Zellenmarkierung eines Tabellenblattes wurde geändert.
Anwendung_WindowActivate(ByVal Wb As Excel.Workbook, ByVal Wn As Excel.Window)
Ein neues Fenster wurde aktiviert (Fensterwechsel).
Anwendung_WindowDeactivate(ByVal Wb As Excel.Workbook, ByVal Wn As Excel.Window)
Ein Fenster wurde verlassen (Fensterwechsel).
Anwendung_WindowResize(ByVal Wb As Excel.Workbook, ByVal Wn As Excel.Window)
Die Größe eines Fensters wurde verändert.
Anwendung_WorkbookActivate(ByVal Wb As Excel.Workbook)
Eine neue Arbeitsmappe wurde aktiviert (Arbeitsmappenwechsel).
Anwendung_WorkbookAddinInstall(ByVal Wb As Excel.Workbook)
Eine Arbeitsmappe wurde als Add-In installiert.
Anwendung_WorkbookAddinUninstall(ByVal Wb As Excel.Workbook)
Eine Arbeitsmappe wurde als Add-In deinstalliert.
Anwendung_WorkbookBeforeClose(ByVal Wb As Excel.Workbook, Cancel As Boolean)
Eine Arbeitsmappe soll geschlossen werden.
Anwendung_WorkbookBeforePrint(ByVal Wb As Excel.Workbook, Cancel As Boolean)
Eine Arbeitsmappe soll ausgedruckt werden.
Anwendung_WorkbookBeforeSave(ByVal Wb As Excel.Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
Eine Arbeitsmappe soll geschlossen werden.
Anwendung_WorkbookDeactivate(ByVal Wb As Excel.Workbook)
Eine Arbeitsmappe wurde verlassen (Arbeitsmappenwechsel).
Anwendung_WorkbookNewSheet(ByVal Wb As Excel.Workbook, ByVal Sh As Object)
In einer Arbeitsmappe wurde ein neues Tabellenblatt eingefügt.
Anwendung_WorkbookOpen(ByVal Wb As Excel.Workbook)
Eine neue Arbeitsmappe wurde geöffnet.

Bei Eingabe in eine Zelle (Worksheet_Change)Makro/Sub/Prozedur

Kategorien: Tabelle ▸ Zellen und Ereignisse ▸ Tabellen

(Tipp 153) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich erreichen, daß bei einer Eingabe in eine Zelle andere Eintragungen automatisch erfolgen?

Grundsätzlich

  • Mit Alt und F11 in den VBA-Editor wechseln,
  • im Projekt-Explorer auf die Tabelle doppelklicken, in der die Eingaben vorgenommen werden,
  • dort entsprechenden Code eingeben.

Fragen treten oft auf, wenn es Endlosschleifen gibt, wenn Code etwas in einen Bereich einträgt, der durch einen Eventhandler überwacht wird. Die Änderung löst das Event aus, wodurch Code aufgerufen wird, der dann wieder etwas einträgt, was dann wieder das Event auslöst usw.

In solchen Fällen bietet sich an, vor dem Vornehmen von Änderungen die Events/Ereignisse auszuschalten und danach gleich wieder zu aktivieren:

Application.EnableEvents = False '… Code … Application.EnableEvents = True


Datum über der Eingabezelle eintragen

Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Row = 2 Then Cells(Target.Row - 1, Target.Column) = Date End Sub


Wert auf anderes Blatt in erste leere Zelle eintragen

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim lngZ As LongPtr If Target.Address <> "$B$1" Then Exit Sub lngZ = Sheets(2).Cells(Rows.Count, 4).End(xlUp).Row Sheets(2).Cells(lngZ + 1, 4) = Range("b1") End Sub

Es wird zunächst geprüft, ob die Eingabezelle wirklich B1 ist.

Anschließend wird die Zeile der letzten ausgefüllten Zelle auf Blatt 2 in Spalte 4 (D) festgestellt. Dort wird die Eingabe in die nächste Zeile (lngZ + 1) eingetragen.


Bei Änderungen ungerade Spalten ausschließen

Frage: Wie kann ich bei der Änderung einer Auswahl in den Spalten 3 bis 49 abfragen, ob es sich um eine ungerade Spalte handelt?

Die Routine fragt ab, ob es sich bei der ausgewählten Spalte um eine Spalte handelt, bei deren Division durch 2 der Rest 1 ergibt.

Private Sub Worksheet_Change(ByVal Target As Excel.Range) With Target If .Column > 2 And .Column < 50 And .Column Mod 2 = 1 Then Exit Sub End With 'Hier geht's weiter End Sub

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

On-Event-Ereignisse des Application-ObjektsMakro/Sub/ProzedurTipp

Kategorien: Basics ▸ Ereignisse und Ereignisse ▸ Basics

(Tipp 100) Nachricht zum Beitrag an Autor Nach oben

Die OnEvent-Methoden können in jeder beliebigen Prozedur stehen. Normalerweise stehen sie jedoch im Workbook_Open-Ereignis und sollten vor dem Beenden der Mappe mit z. B. Application.OnKey "" wieder entschärft werden. Durch die Zeichenfolge "" werden die OnEvents deaktiviert.

Ereignisse

Application.OnKey "Taste", "Makro"
bewirkt, das beim Drücken einer Taste das Makro aufgerufen wird. Z. B. ruft Application.OnKey "N", "Test", beim Drücken Taste N das Makro Test auf.
Application.OnRepeat "Wiederholung: xxx", "Makro"
bewirkt, das bei dem Kommando Bearbeiten/Wiederholen das Makro ausgeführt wird. Dabei muß man für xxx den Text eintragen, der im Menü angezeigt wird, also z. B. "Zellen einfügen"
Application.OnUnDo "Rückgängig: xxx", "Makro"
bewirkt, das bei dem Kommando Bearbeiten/Rückgängig das Makro ausgeführt wird. Dabei muß man für xxx den Text eintragen, der im Menü angezeigt wird, also z. B. "Zellen einfügen"
Application.OnTime Zeitangabe, "Makro", Endzeit
bewirkt, das zum Zeitpunkt der Zeitangabe das Makro gestartet wird. Gibt man die Endzeit (dieser Prameter ist optional) mit an, so versucht Excel bis zum Verstreichen dieser Zeit das Makro zu starten. Dies kann z. B. der Fall sein, wenn ein Dialog geöffnet ist, oder ein anderes Makro läuft. Kann Excel das Makro nicht innerhalb dieser Zeit starten, wird darauf verzichtet.
Application.OnTime Zeitangabe, "Makro", , False
setzt man den vierten Parameter auf False, wird diese OnTime-Methode deaktiviert.
Application.OnEntry = "Makro"
wird bei der Eingabe in eine Zelle ausgeführt, nicht aber, wenn ein Makro den Zellwert verändert. Dies kann gegenüber Worksheet_Change ein Vorteil sein.

Rechnen ohne Gleichheitszeichen (Worksheet_Change)Makro/Sub/ProzedurUDF - benutzerdefinierte Funktion

Kategorien: Ereignisse ▸ Tabellen und Tabelle ▸ Formeln

(Tipp 417) Nachricht zum Beitrag an Autor Nach oben

In Spalte A werden Berechnungen ohne Gleichheitszeichen eigetragen. Wie erhalte ich in B die Ergebnisse?

Worksheet_Change-Ereignis

Die Routine wird im VBA-Editor in das Modul eingetragen, das durch Doppelklick auf die Tabelle, in der der Code wirken soll, geöffnet wird. Es werden hier zwei Varianten aufgezeigt: In Spalte B wird eine Formel eingetragen, die das Ergebnis liefert. Falls ein Ergebnis ohne Formel gewünscht wird, wird dies noch in Spalte C eingetragen.

Die Routine wird nur ausgeführt, wenn die Eingabezelle in Spalte 1 (A) ist. Dann werden zunächst die Zielzellen daneben in B und C geleert.

Da intern mit Punkt statt Komma als Dezimaltrenner gerechnet wird, wird ein eventuell vorhandenes Komma zuerst ersetzt. Anschließend wird mit Evaluate versucht, zu berechnen. Wird die Berechnung erkannt, wird ein Ergebnis geliefert, sonst der Fehler #NAME?. Letzteres kommt zum Beispiel vor, wenn ein Text in A eingetragen wurde.

Tritt kein Fehler auf, wird in B die entsprechende Formel eingetragen, in C direkt das Ergebnis.

Private Sub Worksheet_Change(ByVal Target As Range) Dim varTemp, varErg If Target.Column > 1 Then Exit Sub Range("B" & Target.Row & ":C" & Target.Row).ClearContents varTemp = Replace(Target, ",", ".") varErg = Application.Evaluate(varTemp) If Not IsError(varErg) Then Cells(Target.Row, 2).Formula = "" & "=" & varTemp & "" Cells(Target.Row, 3) = varErg End If End Sub


UDF - benutzerdefinierte Funktion

Es ist (in diesem Fall ab Excel 365) auch möglich, das Ergebnis der Berechnung ohne Gleichheitszeichen per Formel zu erhalten. Notwendig ist dazu eine solche benutzerdefinierte Funktion in einem Standardmodul:

Function Evaluate_String(ByVal strString As String, Optional intWas As Integer = 0) Dim varTemp, varErg Evaluate_String = "" varTemp = Replace(strString, ",", ".") varErg = Application.Evaluate(varTemp) If Not IsError(varErg) Then Evaluate_String = IIf(intWas <> 0, "=" & varTemp & "", varErg) End Function

In die Zelle, in der das Ergebnis der Formel ohne Gleichheitszeichen erscheinen soll, muss dann nur:

=Evaluate_String(C10)

Wenn die Formel nicht das Ergebnis, sondern die Formel (also mit Gleichheitszeichen) anzeigen soll, kann als zweiter Parameter etwas anderes als 0 verwendet werden, zum Beispiel:

=Evaluate_String(C10;1)

Sie hat dann ein vergleichbares Verhalten wie die integrierte Funktion FORMELTEXT().



UDF - Benutzerdefinierte Funktionen (auch Matrixfunktionen)Makro/Sub/ProzedurUDF - benutzerdefinierte FunktionTipp

Kategorien: Basics ▸ UDF und UDF ▸ Basics

(Tipp 164) Nachricht zum Beitrag an Autor Nach oben

Grundsätzliches

Benutzerdefinierte Funktionen, also UDF, sind Funktionen, die man sich selbst im VBA-Editor erstellt. Dazu benennt man sie nicht mit Sub, sondern mit Function. Der Name der Funktion liefert dabei den Rückgabewert. Heißt also eine Funktion "MeineFunktion(...)", schreibt man in die Zelle "=MeineFunktion(...)". Ebenfalls kann man Funktionen einsetzen, um durch Subs bestimmte Berechnungen durchführen zu lassen.

Beispiel: Eine Funktion, die immer das Datum zurückgibt, das in 14 Tagen liegt, Die Funktion braucht keine Parameter, sie wäre schlicht und einfach:

Function Datum_14Tage() Datum_14Tage = Date + 14 End Function

Darauf können wir einfach per Sub zugreifen:

Sub Datumstest() MsgBox Datum_14Tage End Sub

Oder in die Zelle eingetragen:

=Datum_14Tage()


Ergebnisse/Rückgaben

Prinzipiell können benutzerdefinierte Funktionen alle möglichen Datentypen als Rückgabewerte haben: Strings, Zahlen, Datumsangaben usw. Selbst Arrays können Ergebnisse sein, die dann von anderen Subs verarbeitet werden.


Dynamische Arrayformeln/Matrixfunktionen

Seit Excel 365 ist es sogar möglich, Arrays als Ergebnisse solcher (dann Matrix-) Funktionen in Zellen eintragen zu lassen. Nehmen wir folgende Funktion als Beispiel, die für einen Monat eine kleine Liste mit Wochentagen und Kalenderwochen erstellt:

Function Monatstabelle(ByVal intMonatszahl As Integer, ByVal intJahr As Integer) Dim datDatum As Date, arrS(), lngArr As LongPtr datDatum = CDate("1." & intMonatszahl & "." & intJahr) lngArr = 0 Do lngArr = lngArr + 1 ReDim Preserve arrS(1 To 3, 1 To lngArr) arrS(1, lngArr) = datDatum arrS(2, lngArr) = Format(datDatum, "DDD") arrS(3, lngArr) = Application.WorksheetFunction.IsoWeekNum(datDatum) datDatum = datDatum + 1 Loop While Month(datDatum) = intMonatszahl Monatstabelle = Application.WorksheetFunction.Transpose(arrS) End Function

Sie erwartet als Parameter die Zahl des Monats und das Jahr. Wenn diese Angaben in D1 und in E1 stehen, können wir in der Tabelle diese Arrayformel eintragen:

=Monatstabelle(D1;E1)

Tipp nebenbei: Mit Transpose oder in deutscher Syntax MTRANS kann eingestellt werden, in welcher Richtung ein Array ausgegeben wird. Diese (eigentlich Tabellenblatt-) Funktion transponiert den Array, so dass dieser wahlweise über Spalten oder über Zeilen ausgegeben wird.


Formel übergelaufen

Beim ersten Verwenden einer Matrixfunktion (also nicht nur einer eigenen) erscheint die Meldung:

Formel übergelaufen - Ihre Formel hat mehrere Werte zurückgegeben, weshalb wir sie in die benachbarten leeren Zellen haben überlaufen lassen.

Diese Meldung besagt nichts anderes, als dass sich die Zelle mit der Formel nun verhält, wie man es in CSS mit float: left; beschreiben würde. Die Ergebnisse der Formel fließen rechts und unterhalb von der Eingabezelle.

Mit dem Schnittmengenoperator @ nach dem Gleichheitszeichen können Sie übrigens einstellen, dass nur der erste Wert des Arrays in der Zelle erscheint.


Um zu gewährleisten, dass eine in einem Tabellenblatt eingesetzte UDF immer rechnet, sollte man an den Anfang der Funktion schreiben:

Application.Volatile

Zeit ohne Doppelpunkt eingeben

Kategorie: Add-In ▸ Datum und Zeit

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

Wie kann ich viele Uhrzeiten eingeben, ohne immer den entfernten Doppelpunkt nutzen zu müssen?

Mit diesem Add-In können Zeiten mit dem „+“-Zeichen statt des Doppelpunktes eingegeben werden. So kann die Hand beim Num-Block bleiben.

Hinweis:
Mit dem Add-In »Ribbonkalender“ kann auch ein anderes Zeichen eingestellt werden; außerdem stehen noch weitere Datums- und Zeitfunktionen zur Verfügung.

Download: zeit_ohne_doppelpunkt.xlam