Software für Sie.

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

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!

=ANZAHL2(A1:A9999)

Wenn nur die letzte Zeile festgestellt werden soll:

Sub letzteZeile() MsgBox Cells(Rows.Count, 1).End(xlUp).Row End Sub

Zellen mit Inhalt:

Sub ZellenZaehlen() Dim intI As Integer, rngZelle As Range intI = 0 For Each rngZelle In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Cells If rngZelle.Value <> "" Then intI = intI + 1 Next MsgBox intI End Sub

Formel:

=ANZAHL2(C1:C8)

VBA mit Nutzung der der Worksheetfunction:

MsgBox Application.WorksheetFunction.CountA(Range("C2:C20"))

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.

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.

Mit Excel 365 wurde das System der Formeln neu erarbeitet, wie mehrfach berichtet wurde. Allerdings handelt es sich dabei eigentlich nur um eine Ergänzung, wenn auch eine sehr sinnvolle und nützliche. Die alten Formeln arbeiten ganz normal weiter - hier muss nicht befürchtet werden, dass irgendetwas nicht mehr funktioniert. Neu sind hingegen die Arrayformeln. Zum Vergleich: Bisher konnte in Formeln mit kompletten Bereichen gearbeitet werden, zum Beispiel mit Summewenn. Die Eingabe der Formeln musste dazu mit Strg + Umschalt + Enter abgeschlossen werden, woraufhin Excel um die Formel geschweifte Klammern {} legte. Die Formel wurde somit als Matrixformel erkannt und es wurde ein kompletter Bereich verarbeitet. Das ERgebnis hingegen stand als ein Wert in einer Zelle.

Natürlich kann die als Arrayfunktion verwendete Wenn-Funktion auch in anderen Funktionen eingesetzt werden. Hier werden alle Zahlen aus C addiert, wenn sie grö�er als 400 sind:

=SUMME(WENN(C2:C13>400;C2:C13))

In dem Fall haben wir natürlich wieder nur ein Ergebnis, nicht eine Matrix aus mehreren Werten

---

Fehler: #Ã?BERLAUF! bzw. #SPILL!

---

Schnittmengenoperator @

Dieses Verhalten hängt unmittelbar mit den Arrayformeln bzw. Arrayfunktionen zusammen. Nehmen wir obige Formel:

=WENN(C2:C13>400;C2:C13;"")

Sie liefert, wie wir gesehen haben, alle Werte, die grö�er als 400 sind, in und unter der Zelle mit der Formel. Was nun aber, wenn wir nur ein Ergebnis benötigen, das erste? Dieser Fall kann auftreten, wenn Formeln über mehrere Zellen gezogen oder wenn Funktionen verschachtelt werden sollen. In diesem Fall setzen wir direkt hinter das Gleichheitszeichen das @-Zeichen:

=@WENN(C2:C13>400;C2:C13;"")

Nun haben wir nur noch ein Ergebnis; in diesem Fall das erste, die 500.

Um bei diesem Beispiel zu bleiben: Setzen wir in der Formel die letzte Zeile absolut (durch das $-Zeichen), kann die Formel nach unten gezogen werden und wir haben als Ergebnis immer den Wert aus den Zellen ab der Zeile mit der Formel:

=@WENN(C2:C$13>400;C2:C$13;"")

Vor Excel 365 konnten natürlich auch einfach benutzerdefinierte Funktionen (UDF) erstellt werden. Wurden sie als Tabellenblattformeln verwendet, galt natürlich das, was generell für Formeln zählte: Es konnte ein Ergebnis pro Zelle erscheinen. Brauchte man mehr Ergebnisse, musste eine Sub() ran, die die Eintragungen in die Zellen vornahm.

Mit den Arrayformeln ab Excel 365 gab und gibt es nun weitaus mehr und vor allem vielfältige Möglichkeiten. So kann eine eigene Funktion einen kompletten Array als Ergebnis liefern - dieser wird dann als übergelaufene Formel in die Zellen neben und unterhalb der Zelle mit der Formel eingetragen.

Als Beispiel eine Funktion, die einen einfachen Monatskalender erstellt:

Function MonatsKalender(ByVal intMonat As Integer, ByVal intJahr As Integer) Dim intArr As Integer, intI As Integer, datDatum As Date Dim arrRet() MonatsKalender = "" intArr = 0 datDatum = CDate("1." & intMonat & "." & intJahr) Do intArr = intArr + 1 ReDim Preserve arrRet(1 To 3, 1 To intArr) arrRet(1, intArr) = Format(datDatum, "DD.MM.YYYY") arrRet(2, intArr) = Format(datDatum, "DDDD") arrRet(3, intArr) = IIf(Weekday(datDatum, vbMonday) = 7, "Frei!", "Arbeiten!") datDatum = datDatum + 1 Loop While Month(datDatum) = intMonat MonatsKalender = arrRet End Function

An die Funktion werden als Parameter die Zahlen für Monat und Jahr übergeben. Die Funktion erhöht dann das Datum so lange, wie der Monat des aktuellen Datums gleich dem übergebenen Monat ist. Bei jedem Datum werden Datumsangabe, Wochentag und ein Eintrag ("Frei!" oder "Arbeiten!") in einen Array eingetragen.

---

Transponieren: MTRANS oder TRANSPOSE

Allerdings wird es in vielen Fällen so sein, dass die Richtung der Ergebnisse nicht wie gewünscht ist. Wir haben im Array die Spalten redimensioniert und die Datumsangaben dort eingetragen, also erscheinen die Datumsangaben auch auf die Spalten verteilt.

Dies ist jedoch kein Problem - das Verhalten des Eintragens der Arrayelemente kann mit der integrierten Tabellenblattfunktion MTRANS() geändert werden. Dazu wird die eigene Funktion (oder bei Bedarf auch andere Funktionen) in Mtrans gesetzt:

=MTRANS(monatskalender(B1;B2))

Schon haben wir den Kalender so, wie wir ihn wahrscheinlich erwartet haben.

Eine Alternative ist, diese Tabellenblattfunktion MTRANS() gleich in der Funktion einzusetzen und den Array bereits vor der Ausgabe zu drehen:

MonatsKalender = Application.WorksheetFunction.Transpose(arrRet)

Zu sehen ist, dass im VBA-Code die englischsprachige Variante genutzt werden muss, die hier Transpose ist.

Integrierte Möglichkeiten von Excel (Funktionen, Methoden) können um ein Vielfaches schneller sein, als wenn man diese selbst per VBA erstellt bzw. nachgestaltet. So war es schon immer ein gro�er Unterschied, ob man die Find-Methode von Excel nutzte oder eine Schleife über viele Zellen laufen lie�, um einen bestimmten Wert zu finden. Insofern kann auch in Betracht gezogen werden, mit VBA Arrayformeln (bzw. integrierte Arrayfunktionen) zu nutzen und deren Ergebnisse zu verarbeiten.

Evaluate()

Vor den Erläuterungen zu den Arrayfunktionen in VBA eine Vorbemerkung zu EVALUATE(), einer Methode, die recht unbekannt, hier aber oft nützlich ist.

Von anderen Sprachen kennt man eval() is evil - in Excel/VBA macht die Methode genau das, was hinter dem Spruch steckt, ist aber bei richtiger Verwendung ungefährlich. Eine Beschreibung ist bei Microsoft zu finden; wir nutzen diese Methode hier, um Formeln/Funktionen interpretieren zu lassen und zu Ergebnissen zu führen.

Dieser Hinweis war wichtig, weil hier in der Folge eine Formel ohne Funktion (also auch ohne Application.WorksheetFunction) verwendet wird, um Arrayformeln in VBA möglichst einfach zu demonstrieren:

Rückgabe: Array

Basis zum Verwenden von Arrayformeln in VBA ist, dass sie Arrays zurückgeben. Schlie�lich ist dies auch beim Einsatz auf dem Tabellenblatt der Fall, nur dass wir dort die Ergebnisse in Zellen sehen. Entsprechend ist auch wichtig zu wissen, dass Bereiche in Arrayergebnissen zwei Dimensionen haben können, strukturiert in Zeilen und Spalten sind.

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

Ab Excel 365

Zunächst muss das Blatt mit dem Monatsnamen des aktuellen Datums ermittelt werden. Das geht mit Indirekt:

=INDIREKT(TEXT(HEUTE();"MMMM")&"!A1:AE1")

Diese Formel liefert die komplette erste Zeile mit den Datumsangaben des aktuellen Monats. Sie kann nun in der Funktion FILTER() als Suchbereich verwendet werden. Damit können alle Mitarbeiter des Tages ermittelt werden (hier bis Zeile 30):

=FILTER(INDIREKT(TEXT(HEUTE();"MMMM")&"!A2:AE30");INDIREKT(TEXT(HEUTE();"MMMM")&"!A1:AE1")=HEUTE())

Die Formel gibt aus der Datumsspalte alle Einträge zurück, die bis Zeile 30 liegen.

Da aber mehr Zeilen (wie hier bis 30) verwendet werden müssen (die maximale Anwesenheit muss ja berücksichtigt werden), liefert diese Formel für die leeren Zellen, in denen also kein Mitarbeiter eingetragen ist, jeweils eine 0. Das kann also weder mit ANZAHL() noch mit ANZAHL2() gezählt werden, da sonst die 0 immer einflie�en würde.

Wir verwenden im Beispiel SUMME(Wenn( und lassen die Einträge zählen, die <> 0 sind:

=SUMME(WENN(FILTER(INDIREKT(TEXT(HEUTE();"MMMM")&"!A2:AE30");INDIREKT(TEXT(HEUTE();"MMMM")&"!A1:AE1")=HEUTE())<>0;1;0))

Ã?ltere Versionen

Hier ist die Formel etwas länger:

=ANZAHL2(INDIREKT(TEXT(HEUTE();"MMMM")&"!"&LINKS(ADRESSE(1;VERGLEICH(HEUTE();INDIREKT(TEXT(HEUTE();"MMMM")&"!1:1"));4);1+(VERGLEICH(HEUTE();INDIREKT(TEXT(HEUTE();"MMMM")&"!1:1"))>26))&"2:"&LINKS(ADRESSE(1;VERGLEICH(HEUTE();INDIREKT(TEXT(HEUTE();"MMMM")&"!1:1"));4);1+(VERGLEICH(HEUTE();INDIREKT(TEXT(HEUTE();"MMMM")&"!1:1"))>26))&"1000"))

Grüne Formatierung

Rote Formatierung

Gelbe Formatierung

Wenn nun Zahlen eingetragen werden, sollte das beim ersten Land funktionieren, die Hintergründe müssten automatisch entsprechend der Zahlen formatiert werden. Allerdings müssen die Schritte noch für die anderen beiden Länder wiederholt werden. Beim mittleren Land aufpassen; die Zellen in MIN und MAX müssen hier mit Semikolon getrennt werden, weil es keine Bis-Bereiche sind, sondern auseinanderliegende Zellen.

---

Auswertung: Matrixformel

Unter der Tabelle sollen nun noch zu jedem Land die grünen, roten und gelben Zellen gezählt werden. Das Problem: Mit einer reinen Formellösung können keine farbigen Zellen gezählt werden.

Ein Lösungsansatz ist, zu zählen, wie viele Zellen in der jeweiligen Spalte grö�er bzw. kleiner als die Zellen daneben sind. Damit wir nicht jede Zeile einzeln berücksichtigen müssen, verwenden wir dazu eine Matrixformel, die den Bereich einer Spalte über alle Zeilen hinweg erfasst.

Hinweis: Die geschweiften Klammern nicht eingeben, sondern die Eingabe der Formel mit Strg + Umschalt + Enter abschlieÃ?en. Damit erscheinen die geschweiften Klammern automatisch. Ab Excel 365 sind die geschweiften Klammern nicht mehr notwendig.

Wir beginnen beim ersten Land, hier mit der Formel in E24. Es sollen die Zellen gezählt werden, die in den Zeilen die niedrigsten Preise haben. Dabei zählen wir aber nicht, sondern wir addieren für jede dieser niedrigsten Zellen die 1. Wir bilden also die Summe, hier das Grundgerüst:

=SUMME( wenn Zahl in der Zeile am niedrigsten ; dann addiere 1; sonst addiere 0))

Wir verwenden hier diese Logik (andere Varianten gibt es natürlich auch):

Wenn die Zahl beim Land 1 (E) kleiner als die Zahl beim Land 2 (F) ist, dann wenn die Zahl beim Land 1 (E) auch kleiner als die beim Land 3 (G) ist, dann addiere 1, sonst 0, sonst 0.

Wir addieren hier also zweimal 0 - einmal für die erste Bedingung (Land 1 nicht kleiner als Land 2) und einmal für die zweite Bedingung (Land 1 nicht kleiner als Land 3).

Diese Struktur bauen wir in die Formel ein, so dass die (an Strg + Umschalt + Enter denken!) nun so aussieht:

{=SUMME(WENN(E2:E19<F2:F19;WENN(E2:E19<G2:G19;1;0);0))}

Damit haben wir die Anzahl der grünen Zellen beim Land 1 in E24. Die gleiche Formel kommt zu den anderen Ländern. Vorsicht, die kann aber nicht gezogen werden, weil die Zellen in den Formeln angepasst werden müssen.

Ebenfalls die gleiche Formel, nur mit dem grö�er als >, kommt in die Zeile 26, wo die roten Zellen gezählt werden:

{=SUMME(WENN(E2:E19>F2:F19;WENN(E2:E19>G2:G19;1;0)))}

Bei den gelben Zellen geht es einfacher - einfach alle Zellen in der Spalte zählen und die grünen und roten subtrahieren:

=ANZAHL(E2:E19)-E24-E26

Eine Beispieldatei mit dieser Lösung: 326_preisvergleiche.xlsx

Basis: In Spalte A (im Code also 1) stehen aufsteigend sortiert und ohne leere Zellen dazwischen die Zeiten.

Zum Umsetzen der Aufgabenstellung benötigen wir vier einzelne Routinen. Diesen müssen wir zwei Variablen zur Verfügung stellen, die deshalb ganz am Anfang des Moduls deklariert werden müssen:

Private lngZ As LongPtr Private bolC As Boolean

In der ersten Routine Start() löschen wir die Zellinhalte neben den Uhrzeiten und legen in lngZ die erste Zeile mit einer Uhrzeit fest. Dazu setzen wir bolC auf True. Das Makro, das später die Eintragungen vornimmt, wird diese Variable prüfen und den Vorgang nur fortsetzen, wenn diese auf True gesetzt ist. Anschlie�end starten wir den Vorgang mit der Sub ZeitFestLegen():

Sub Start() lngZ = 2 'erste Zeile mit Uhrzeit Range(Cells(lngZ, 2), Cells(Rows.Count, 3)).ClearContents bolC = True ZeitFestLegen End Sub

Die Sub ZeitFestLegen() hat nur folgende Aufgaben:

• prüfen, ob in Spalte A der Zeile lngZ eine Zeit steht,
• prüfen, ob bolC noch True ist,
• wenn zweimal ja: festlegen, dass bei der Zeit in Zeile lngZ etwas passiert (das Makro Eintragen ausführen) - zunächst ist das hier die Zeit in Zeile 2, weil wir die bereits in lngZ festgelegt haben:

Sub ZeitFestLegen() Dim datZeitAngabe As Date If Cells(lngZ, 1).Value = "" Then Exit Sub If bolC = False Then MsgBox "Makro wurde angehalten" Exit Sub End If datZeitAngabe = Cells(lngZ, 1).Value Application.OnTime datZeitAngabe, "Eintragen" End Sub

Nun wei� der Code, wann etwas passieren soll, nämlich bei der ersten Zeit. Mit der Sub Eintragen() legen wir fest, was passieren soll. Hier werden einfache Texte in die Nachbarzellen eingetragen.

Nach dem Eintragen wird die Zeile lngZ um 1 erhöht und wieder die Sub ZeitFestLegen aufgerufen, die nun dafür sorgt, dass das Ganze bei der nun in der nächsten Zeile gefundenen Zeit von vorn losgeht - wenn eine Zeit in dieser neuen Zelle steht und bolC immer noch True ist:

Sub Eintragen() Cells(lngZ, 2).Value = "Hallo, Spalte B" Cells(lngZ, 3).Value = "Hallo, Spalte C" lngZ = lngZ + 1 ZeitFestLegen End Sub

Das sollte schon mal funktionieren. Aber: Es gibt für den Anwender keine Möglichkeit, das vorzeitig abzubrechen. Bei der nächsten Zeit wird eingetragen und sofort die neue Zeit festgelegt.

Deshalb sollten wir eine Möglichkeit einbauen, den Wert der Variablen bolC auf False zu setzen, damit die Sub ZeitFestLegen den Vorgang abbricht. Dazu reicht das Stück Code, das man vielleicht an einen Button o. ä. binden kann:

Sub Stoppen() bolC = False End Sub

Mit Application.ScreenUpdating = False kann ausgeschaltet werden, dass der Excel-Bildschirm aktualisiert wird. Wenn oft automatisiert mit Zellen gearbeitet wird, kann das sinnvoll sein - einerseits flackert es dann nicht so, andererseits wird die Laufzeit teilweise erheblich verkürzt, wenn nicht sofort alle �nderungen angezeigt werden.

Allerdings sollte nicht vergessen werden, diese Aktualisierung wieder einzuschalten. Vergisst man dies, ist der Bildschirm eventuell an wichtiger Stelle â??eingefrorenâ??. Man kann das zwar einfach mit Application.ScreenUpdating = True beheben - wenn es jedoch einem anderen Anwender passiert, kann das mächtig irritieren.

---

Dim strDateiPfad As String strDateiPfad = "C:\eigene dateien\test.xlsx" Application.ScreenUpdating = False Workbooks.Open Filename:=strDateiPfad ThisWorkbook.Activate Application.ScreenUpdating = True

Sinnvoll kann es auch sein, vor der Ausführung des gewünschten Codes die Eigenschaft in einer Variablen zu speichern, wie z. B. bolScrUpd = Application.ScreenUpdating. Nach dem relevanten Code setzt man das dann auf den Ausgangszustand mit Application.ScreenUpdating = bolScrUpd zurück.

Natürlich kann man den gesamten Pfad am Backslash splitten oder andere Stringoperationen anwenden. Am einfachsten ist es aber sicher, wenn man sich mit Dir() den Dateinamen zurückgeben lässt - das geht auch mit allen Dateien, nicht nur mit Exceldateien.

Dir()

Rein für den Dateinamen wäre dies eine einfache Möglichkeit:

Sub DateinamenExtrahieren() Dim varDName varDName = Application.GetOpenFilename If varDName = False Then MsgBox "Nichts gewählt." Else varDName = Dir(varDName) MsgBox varDName End If End Sub

Für alle Angaben aus dem Pfad, also Ordner und Datei, könnte folgende Variante genutzt werden:

Sub DateiPfad() Dim strGesamt As String, strDatei As String, strOrdner As String strGesamt = Application.GetOpenFilename strDatei = Dir(strGesamt) strOrdner = Left(strGesamt, Len(strGesamt) - Len(Dir(strGesamt))) MsgBox strDatei & vbNewLine & strOrdner & vbNewLine & strGesamt End Sub

Wenn davon ausgegangen werden kann, dass die Zeichenfolge des Dateinamens einmalig im Pfad ist, kann auch einfach ersetzt werden:

Sub DateiAusPfad2() Dim varPfad, strOrdner As String, strDatei As String varPfad = Application.GetOpenFilename If varPfad <> False Then strDatei = Dir(varPfad) strOrdner = Replace(varPfad, strDatei, "") MsgBox strDatei & vbNewLine & strOrdner End If End Sub

---

Regulärer Ausdruck

Noch eine Variante für die Freunde regulärer Ausdrücke:

Sub DateiAusPfad3() Dim varDName, Regex As Object, regMatches, regMatch varDName = Application.GetOpenFilename If varDName = False Then MsgBox "Nichts gewählt." Else If Regex Is Nothing Then Set Regex = CreateObject("VBScript.RegExp") Regex.Pattern = "^(.+[\\\/])(.*)$" Set regMatches = Regex.Execute(varDName) MsgBox regMatches(0).SubMatches(1) Set Regex = Nothing End If End Sub

Der Schrägstrich wurde aufgenommen, weil Pfade in Onedrive gespeicherter Dateien mit Schrägstrich geliefert werden.

Sollen Ordner und Dateiname zurückgegeben werden, wäre dies möglich:

Sub DateiAusPfad4() Dim varPfad, strOrdner As String, strDatei As String Dim Regex As Object, regMatches, regMatch varPfad = Application.GetOpenFilename If varPfad <> False Then If Regex Is Nothing Then Set Regex = CreateObject("VBScript.RegExp") Regex.Pattern = "^(.+[\\\/])(.*)$" Set regMatches = Regex.Execute(varPfad) strOrdner = regMatches(0).SubMatches(0) strDatei = regMatches(0).SubMatches(1) Set Regex = Nothing MsgBox strDatei & vbNewLine & vbNewLine & strOrdner End If End Sub

Die integrierte Funktion =ZELLE("Dateiname";A1) liefert den kompletten Pfad bis zum Tabellenblatt. Der Dateiname ist dabei in eckige Klammern eingeschlossen: Pfad[Dateiname]Blattname. Mit einem regulären Ausdruck können die einzelnen Bestandteile ausgegeben werden (ggf. noch Fehlerbehandlung einbauen):

Sub DateiAusZellFunktion() Dim strPfad, strOrdner As String, strDatei As String, strBlatt As String Dim Regex As Object, regMatches, regMatch strPfad = Evaluate("=cell(""filename"",A1)") If Regex Is Nothing Then Set Regex = CreateObject("VBScript.RegExp") Regex.Pattern = "^(.*)\[(.*)\](.*)$" Set regMatches = Regex.Execute(strPfad) strOrdner = regMatches(0).SubMatches(0) strDatei = regMatches(0).SubMatches(1) strBlatt = regMatches(0).SubMatches(2) Set Regex = Nothing MsgBox strBlatt & vbNewLine & strDatei & vbNewLine & strOrdner End Sub

---

Dynamische Matrixformel (Arrayformel) und verschütteter Array

Per benutzerdefinierter Funktion können seit Excel 365 auch die einzelnen Ordner bzw. Bestandteile eines Pfades in Zellen ausgegeben werden. Dazu diese Funktion als Beispiel:

Function PfadDetails(ByVal strPfad As String) PfadDetails = "" If strPfad <> "" Then Select Case True Case InStr(1, strPfad, "\") > 0: PfadDetails = Split(Replace(strPfad, "\\", "\"), "\") Case InStr(1, strPfad, "/") > 0: PfadDetails = Split(Replace(strPfad, "//", "/"), "/") End Select End If End Function

In die Zelle kommt dann diese Formel:

=PfadDetails(A5)

Wenn wie hier im Beispiel in A5 ein Pfad steht, werden an der Zelle mit der Formel die einzelnen Elemente des Pfades ausgegeben. Das letzte Element sollte bei einem kompletten Pfad zu einer Datei der Dateiname sein.

Das Beispiel mit der Funktion =ZELLE("Dateiname";A1) kann auch als Arrayformel verwendet werden:

Function DateiAusZellFunktion(strFktPfad) Dim arrTemp(1 To 3) Dim Regex As Object, regMatches, regMatch DateiAusZellFunktion = "" If strFktPfad <> "" Then If Regex Is Nothing Then Set Regex = CreateObject("VBScript.RegExp") Regex.Pattern = "^(.*)\[(.*)\](.*)$" Set regMatches = Regex.Execute(strFktPfad) If regMatches.Count = 1 Then arrTemp(1) = regMatches(0).SubMatches(2) arrTemp(2) = regMatches(0).SubMatches(1) arrTemp(3) = regMatches(0).SubMatches(0) DateiAusZellFunktion = arrTemp End If Set Regex = Nothing End If End Function

In die Zelle kommt dann =DateiAusZellFunktion(ZELLE("Dateiname";A1)) und in ihr sowie den Nachbarzellen werden Blattname, Dateiname und Ordnerpfad erscheinen.

---

Formeln/integrierte Funktionen

Den aktuellen Ordner gibt diese Funktion zurück:

=INFO("Verzeichnis")

---

In anderen Sprachen geht übrigens auch einfach Basename(Pfad).

Mit dem Add-In können Daten aus einer Mappe in separate Textdateien exportiert werden. Diese stehen anschlie�end für einen Import zur Verfügung (sind also auch gleichzeitig Sicherunsgkopie), wobei sie dann in die gleichen Zellen geschrieben werden. So können verschiedene Szenarios erstellt werden oder die Daten stehen auch anderen Arbeitsplätzen zur Verfügung.

Hinweis:
Mit dem Add-In »Excel-Kommunikator« können Sie ebenfalls komplette Tabellenbereiche exportieren und zwar so, dass sie sofort anderen Nutzern zur Verfügung stehen. Sie brauchen sich dort nur in einer Gruppe zu befinden, damit Sie sofort Daten austauschen können.

Download: datenexport.xlam

Dazu gibt es verschiedene Möglichkeiten. Manche haben Nachteile, zum Beispiel Probleme mit UTF-8 oder dass gesendete Daten in den Server-Logs erscheinen.

Empfehlenswert ist das MSXML2.XMLHTTP-Objekt, mit dem per POST Formulardaten ganz einfach gesendet und Antworten empfangen werden können. Die Daten werden einfach als key=value-Kombinationen an die Adresse des Server-Scripts (Beispiel: PHP) übergeben. Ein einfaches Beispiel dazu:

Sub Post_mit_Response() Dim strURL As String, strPostDaten As String strURL = "https://example.org/phptest.php" strPostDaten = "" strPostDaten = strPostDaten & "name=Müller" strPostDaten = strPostDaten & "&vorname=Hans" strPostDaten = strPostDaten & "&strasse=Blumenweg 22" strPostDaten = strPostDaten & "&ort=Musterort" With CreateObject("MSXML2.XMLHTTP") .Open "POST", strURL, False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .Send (strPostDaten) If .ResponseText <> "" Then 'Response je nach Anforderung prüfen MsgBox .ResponseText 'Antwort des Servers ausgeben Else MsgBox "Schiefgegangen.", vbOKOnly + vbCritical, "Fehler" End If End With End Sub

Ein Beispiel für ein zugehöriges PHP-Script:

$adresse = "Die Adresse ist:\n\n"; $adresse .= $_POST['vorname'] . " " . $_POST['name'] . "\n"; $adresse .= $_POST['strasse'] . "\n"; $adresse .= $_POST['plz'] . " " . $_POST['ort'] . "\n"; echo $adresse;

In diesem Beispiel würde PHP aus den einzelnen Angaben eine formatierte Adresse gestalten und diese an VBA senden.

Dadurch können u. a. Daten aus Zellen oder Userformen ganz einfach per Mausklick, Tastendruck oder auch per Event an ein Script auf dem Server gesendet werden, das dann die weitere Verarbeitung erledigt. Somit können Mails versendet oder Eintragungen in Datenbanken (z. B. mySQL) vorgenommen werden usw.

Die Antwort des Servers ist hier natürlich nur reiner Text. Für komplexere Vorgänge sollten Sie sich ansehen, was in der Zusammenarbeit von VBA mit JSON möglich ist.

Download: excel_php_json.xlsm

Zum Verketten von Zeichenfolgen bieten sich zum Beispiel diese Möglichkeiten an:

---

Formeln

="abc " & A1 & "def"

=A20&" "&TEXT(C2; "MM/JJ")

=VERKETTEN(A20;" ";TEXT(C2; "MM/JJ"))

Vorausgesetzt wird, das in C2 das komplette Datum steht. Ansonsten kann die Textformatierung in den Funktionen auch entfallen.

---

Soll ein Datum formatiert verwendet werden, ist das so möglich:

=TEXT(C2;"TT.MM.JJ ")&A1

---

Ein Zeilenumbruch kann so in die Zelle eingefügt werden:

=A1&ZEICHEN(10)&B1&" "&C1&ZEICHEN(10)&D1&ZEICHEN(10)&ZEICHEN(10)&E1&" "&F1

Allerdings ist dies ein zusätzliches Zeichen, was bei etwaigen Textvergleichen berücksichtigt werden muss. In Rohdaten sollte das deshalb vermieden und nur bei der reinen Ausgabe verwendet werden.

---

Ein HTML-Link kann aus den Angaben in Zellen so erstellt werden:

="<a href="&ZEICHEN(34)&B1&ZEICHEN(34)&">"&A1&"</a>"

---

VBA

Zum Ergänzen mehrerer Zellen in einem Bereich ist diese Schleife möglich:

Sub Ergaenzen() Dim rngZelle As Range For Each rngZelle In Range("A1:A10").Cells rngZelle.Value = "abc" & rngZelle.Value & "def" Next End Sub

---

Excel 365: Funktion TEXTVERKETTEN()

Mit dieser Funktion können ganz einfach Texte mit Trennzeichen verkettet werden, wobei die Trennzeichen komplette Strings sein können.

Gibt es zum Beispiel in A1:C5 eine Tabelle, aus der eine HTML-Tabelle erstellt werden soll, kann man einfach in jede Zeile diese Formel eingeben:

="<tr><td>"&TEXTVERKETTEN("</td><td>";;A1:C1)&"</td></tr>"

Zum Schluss gibt man irgendwo diese Formel ein:

="<table>"&TEXTVERKETTEN("";;E1:E5)&"</table>"

Fertig ist die komplette HTML-Tabelle.

Der Code löscht zunächst das Blatt Zusammenfassung, falls es existiert. Alternativ können natürlich auch Zellen oder Zellinhalte dieses Blattes gelöscht werden.

Anschlie�end läuft im Beispiel eine Schleife über die ersten drei Tabellenblätter. Von denen werden die Zellen in den Spalten 1 bis 5 bis zur letzten (in Spalte 1) ausgefüllten Zeile genommen und untereinander auf das Blatt Zusammenfassung kopiert.

Sub speichern() Dim lngZeile As Long, lngLetzteZ As Long, bytI As Byte Dim strBereich As String On Error Resume Next Worksheets("Zusammenfassung").Delete 'Auswertungsblatt löschen On Error GoTo 0: Err.Clear Worksheets.Add after:=Sheets(Sheets.Count) 'Auswertungsblatt einfügen ActiveSheet.Name = "Zusammenfassung" 'Variable, die dafür sorgt, da� die zusammengefa�ten Daten untereinander stehen lngZeile = 1 'hier ab Zeile 1 For bytI = 1 To 3 'Von Blatt 1 bis Blatt 3 zusammenfassen lngLetzteZ = Worksheets(bytI).Cells(Worksheets(bytI).Rows.Count, 1).End(xlUp).Row strBereich = Range(Cells(1, 1), Cells(lngLetzteZ, 5)).Address 'Datenbereich (hier bis Spalte 5) auswählen Worksheets(bytI).Range(strBereich).Copy Sheets("Zusammenfassung").Cells(lngZeile, 1) 'Variable Zeile erhöhen lngZeile = lngZeile + lngLetzteZ Next End Sub

Dazu kann man die Funktion ZUFALLSZAHL nutzen. Allerdings liefert sie Zahlen von 0 bis 1, so dass man sich damit behelfen muss:

=GANZZAHL(ZUFALLSZAHL()*(49-1)+1)

Dabei ist 1 die Untergrenze und 49 die Obergrenze.

Für das Datum gibt es nun verschiedene Möglichkeiten. Es kann die Zahl jedes Datums verwendet werden, Bezüge zu Zellen mit den Datumsangaben sind möglich, aber auch die Datumsangaben in Anführungszeichen sind anwendbar:

• =GANZZAHL(ZUFALLSZAHL()*(29221-21916)+21916)
• =GANZZAHL(ZUFALLSZAHL()*(G9-G8)+G8)
• =GANZZAHL(ZUFALLSZAHL()*("01.01.1980"-"01.01.1960")+"01.01.1960")

Ab Excel 365

Hier geht es wesentlich einfacher:

• =ZUFALLSBEREICH("1.1.60";"1.1.80")
• =ZUFALLSBEREICH(I1;I2)
• =ZUFALLSMATRIX(1;1;"1.1.60";"1.1.80";1)
• =ZUFALLSMATRIX(1;1;I1;I2;1)

Angenommen die Datumsangaben stehen in A2:A8:

Datum aufteilen

Die Datumsangaben können mit Formeln auf mehrere Spalten aufgeteilt werden:

• Jahr: =WENN(ISTZAHL(A2);JAHR(A2);"")
• Monat: =WENN(ISTZAHL(A2);MONAT(A2);"")
• Tag: =WENN(ISTZAHL(A2);TAG(A2);"")

AnschlieÃ?end kann ganz normal nach einer der Spalten sortiert werden.

---

Dynamische Arrayfunktion SORTIERENNACH() (ab Excel 365)

Mit dieser Funktion kann das Sortieren in einem Schritt erledigt werden, sie gibt alle Daten auf einmal sortiert aus.

Nach Monat aufsteigend (die 1 steht für aufsteigend):

=SORTIERENNACH(A2:A8;MONAT(A2:A8);1)

Nach Monat und Tag aufsteigend:

=SORTIERENNACH(A2:A8;MONAT(A2:A8);1;TAG(A2:A8);1)

Falls ein gröÃ?erer Bereich in die Funktion eingetragen werden soll, falls zum Beispiel abzusehen ist, dass es mehr Datumsangaben werden, werden auch die noch leeren Zellen ausgegeben. Das sieht nicht schön aus. Dafür kann die Adresse der letzten Zelle mit INDIREKT() â??zusammengebasteltâ?? werden. Hier als Beispiel über die Funktion ANZAHL():

=SORTIERENNACH(INDIREKT("A2:A"&ANZAHL(A2:A15)+1);MONAT(INDIREKT("A2:A"&ANZAHL(A2:A15)+1));1;TAG(INDIREKT("A2:A"&ANZAHL(A2:A15)+1));1)

Der Druckbereich wird von der Zelle A10 bis zur Spalte E festgelegt. Die letzte Zeile des Druckbereichs ist hierbei die letzte Zeile, in der in Spalte A ein Eintrag vorhanden ist.

Sub druck() Dim intS As Integer, lngE As Long, lngZ As Long 'Spalte A: intS = 1 'Letzte Zeile mit Eintrag suchen: lngE = Cells(Rows.Count, intS).End(xlUp).Row 'Zeilen ausblenden: For lngZ = 10 To lngE If Cells(lngZ, 5) = "" Then Rows(lngZ).EntireRow.Hidden = True Next 'Druckbereich festlegen: ActiveSheet.PageSetup.PrintArea = "$A$10:$E$" & lngE 'Drucken: ActiveSheet.PrintOut 'Druckbereich aufheben: ActiveSheet.PageSetup.PrintArea = "" 'Zeilen einblenden: Rows.Hidden = False End Sub

Oder:

Sub ausblenden() Dim intI As Long, lngE As Long, lngL As Long, intS As Integer 'e = Erste Zeile mit Formel 'l = Zeile, in der Summe steht 's = Spalte, in der die Zellen auf "" überprüft werden sollen lngE = 1 lngL = 20 intS = 3 'Leere Zeilen ausblenden For intI = lngE To lngL If Cells(intI, intS).Text = "" Then Rows(intI).EntireRow.Hidden = True Next 'Drucken ActiveWindow.SelectedSheets.PrintOut Copies:=1 'Zeilen einblenden For intI = lngE To lngL Rows(intI).EntireRow.Hidden = False Next End Sub

Die Beispiele zeigen, wie die letzte ausgefüllte Zelle zu ermitteln ist. In jedem Fall muss dann nur Zeile oder Spalte um 1 erhöht werden, um auf die erste leere Zelle zu kommen.

VBA

Grundsätzlich:

Mit Cells(Rows.Count, 1).End(xlUp).Row können wir abfragen, welche die letzte ausgefüllte Zelle in Spalte A (also 1) ist.

Brauchen wir die letzte ausgefüllte Zelle in einer Zeile, also die Spaltenangabe dieser Zelle, können wir Cells(1, Columns.Count).End(xlToLeft).Column verwenden (hier für Zeile 1).

---

Diese beiden Codestücke funktionieren auch zuverlässig, wenn nicht gerade die erste Zelle in der Spalte bzw. in der Zeile leer ist. In dem Fall würde auch die 1 zurückgegeben - was hie�e, dass diese erste Zelle Inhalt hätte. Aus diesem Grund muss, wenn dies eine Rolle spielen kann, vorher geprüft werden, ob die erste Zelle der Spalte/Zeile auch leer ist. Damit wird dies berücksichtigt:

Dim strAddr As String 'Spalte A, entspricht 1: If IsEmpty(Cells(1, 1)) Then strAddr = Cells(1, 1).Address Else strAddr = Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Address End If Range(strAddr).Value = "Erste leere Zelle"

Stehen in der ersten Zeile grundsätzlich Spaltenüberschriften, spielt das bei der ersten ausgefüllten Zelle in einer Spalte natürlich keine Rolle.

---

Das Eintragen erfolgt dann einfach in die nächste Zelle. Entweder:

Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Select

oder:

a = Cells(Rows.Count, 2).End(xlUp).Row + 1

Entsprechend ist es auch bei der ersten leeren Zelle in einer Zeile:

a = Cells(2, Columns.Count).End(xlToLeft).Column + 1

Wenn etwas in die erste freie Zelle in einer Zeile kopiert werden soll, kann man z. B. so vorgehen:

Sub NaechstfreieSpalte() Selection.Copy Destination:=Cells(ActiveCell.Row, Columns.Count).End(xlToLeft).Offset(0, 1) End Sub

---

Formel

Mit der Funktion ADRESSE() in Verbindung mit ANZAHL2() kann die letzte ausgefüllte Zelle ermittelt werden, wenn sich keine leeren Zellen im Bereich befinden:

=ADRESSE(ANZAHL2(B1:B34)+2;2;4)

Das +2 bedeutet, dass der zu prüfende Bereich erst in B3 beginnt.

Oder:

=INDIREKT("B"&ANZAHL2(B2:B10000)+1)

Das +1 hei�t, dass der erste Wert in B in Zeile 2 steht. Steht der erste Wert in Zeile 1, kann es weggelassen werden. Steht der erste Wert aber in Zeile 3, wäre es +2 usw.

Eine andere Variante, die aber nur bis Spalte Z funktioniert, ist:

=LINKS(ADRESSE(ZEILE($B$6);SPALTE($B$6));3)&ANZAHL2($B$3:$B$65536)+ZEILE($B$3)-1

Excel-Kommunikator: Chat und E-Mail per Excel

Das Add-In ist der Nachfolger des Mail-Add-Ins, an dem immer wieder Interesse bestand. Allerdings war es mit der Zeit veraltet, so dass eine komplette Neuentwicklung langsam überfällig war. Das hier vorgestellte Add-In sollte ab der Version 2007 funktionieren - Nutzer des alten Add-Ins finden hier nur eine andere (und umfangreichere) Bedienung; die alten Daten können mit der gleichen Syntax übernommen werden.

---

JL-Chat JL-Mail Backup/Restore Technik, Datenschutz Kosten

Basis ist ein eigener Nick, der frei gewählt werden kann, jedoch insgesamt nur einmal vorkommen darf. Nach Gro�-/Kleinschreibung wird dabei unterschieden. Dieser Nick muss einmalig im System registriert werden, danach erfolgt die Kommunikation pro Add-In immer mit diesem Nick. Jeder Teilnehmer sieht Sie dann also unter diesem Namen. Die Absenderangaben bei Mails können natürlich unabhängig davon verwendet werden, so dass ein Empfänger Ihren richtigen Namen sieht, wenn Sie diesen beim Mailversand angeben.

---

Chat

Eigener Nickname

Gruppen

Posten und Listenanzeige

Zellen und Bereiche posten

Ausgaben

Neue Nachrichten

---

Mail

Absender

Empfänger

Mailtext, Anhang

Versand

---

Backup und Restore

Backup

Restore

Bei einer leeren Add-In-Datei, wenn also noch kein Nick vergeben ist, ist der Button »Restore« statt des Buttons zur Sicherung sichtbar. Nach dem Anklicken erscheint ein Dialog zum Eingeben des Nicknamens und des Kennworts, das Sie beim ersten Erstellen vergeben haben. Stimmen diese Daten, werden die Daten aus dem letzten Backup in das Add-In eingetragen und es stehen alle Funktionen/Daten wie beim Zeitpunkt des Erstellens des Backups zur Verfügung.

---

Technik, Ausschlüsse und Datenschutz

Da die Daten entfernten Empfängern zur Verfügung gestellt werden, müssen sie natürlich auch irgendwo gespeichert werden. Dies erfolgt auf dem Server joerglorenz.de in einer MySQL-Datenbank, die auf dem aktuellen Stand der Technik abgesichert ist. Au�er mir, dem Autor des Add-Ins, hat niemand Zugriff darauf.

Gespeichert werden nur die Daten, die den Absendern und den Empfängern vorgehalten werden müssen - also all das, was Sie über die Felder im Menüband eingeben. Dateien als Mailanhänge werden auf dem Server nur bis zum letztendlichen Versand der Mail gespeichert und anschlie�end gleich wieder gelöscht. Da das ganze System über Nicknamen läuft, werden auch keine sonstigen personenbezogenen Daten gespeichert - natürlich mit Ausnahme derer, die Sie selbst in den Eingabefeldern/Messages eintragen.

Es wird zugesichert, dass Ihre Daten nur zum eigentlichen Zweck Ihrer Kommunikation gespeichert werden und sonst in keiner Weise verwendet oder überwacht werden. Au�er natürlich, wenn ich selbst davon nichts wei� - ausschlie�en kann man ja leider nichts.

Sollen bestimmte Daten gelöscht werden, wenden Sie sich bitte einfach mit Angabe des Nicknamens an mich.

Verboten sind generell Texte, die gegen Recht und Gesetz versto�en, aber auch fanatische und insbesondere rechte bzw. fremdenfeindliche Inhalte. Sollten solche Texte bemerkt werden, wenden Sie sich bitte an mich. Diese werden dann durch mich unverzüglich gelöscht.

---

Kosten

Dieses Add-In kann leider nicht kostenlos angeboten werden. Sie haben die Möglichkeit, 50 Postings abzusetzen und 50 Mails (an mehrere Empfänger gilt als eine Mail) zu versenden. Eine weitere Nutzung ist dann für 10,00 � pro Add-In (also pro Nick) möglich. Bei Nutzung in Gruppen (Unternehmen, Vereine usw.) kann es verschiedene Ermä�igungen geben, wenn mir eine Liste der zugehörigen Nicks überlassen wird.

Bei Angabe einer Rechnungsanschrift erhalten Sie natürlich in jedem Fall eine absetzbare Rechnung.

Perspektivisch wird das Add-In um weitere Funktionen ergänzt. Diese Erweiterungen sind dann natürlich im Preis bereits enthalten.

Download: excelkomm.xlam

Dieses Makro fügt die Nummern in Spalte E ein und "färbt" in der Spalte F.

Sub Farben() Dim intZ As Integer For intZ = 1 To 56 Cells(intZ, 5) = intZ Cells(intZ, 6).Interior.ColorIndex = intZ Next End Sub

Excel kann jedoch mit wesentlich mehr Farben umgehen, nämlich auch den RGB-Farben. Die kann man natürlich nicht alle auflisten, weil Excel in einer Mappe nur begrenzt Zellformate haben kann. Aber man kann Bereiche darstellen, zum Beispiel so:

Sub Farben1() Dim lngZ As LongPtr, intS As Integer, lngF As Long Dim lngStart As LongPtr Dim datBeg As Date Workbooks.Add ActiveSheet.Columns.ColumnWidth = 5 ActiveWindow.Zoom = 10 intS = 2 lngZ = 0 lngStart = 9895936 On Error GoTo FEHLER For lngF = lngStart To lngStart + 65279 lngZ = lngZ + 1 Cells(lngZ, intS) = lngF Cells(lngZ, intS).Interior.Color = lngF '65430 If lngZ Mod 256 = 0 Then intS = intS + 1 lngZ = 0 End If Next MsgBox Format(Now - datBeg, "mm:ss") Exit Sub FEHLER: MsgBox "Abbruch bei " & lngF & vbNewLine & "Fehler: " & Err.Number & vbNewLine & Err.Description End Sub

Mit der Zahl in lngStart kann einfach experimentiert werden.

Möglich ist auch, mit den RGB-Werten direkt zu arbeiten. Alle auf einmal verkraftet Exel nicht, also muss hier entweder mit Step oder durch kleinere Abbruchwerte reduziert werden:

Sub Farben2() Dim lngZ As LongPtr, intS As Integer, strRGB As String Dim datBeg As Date Dim r As Integer, g As Integer, b As Integer Workbooks.Add ActiveSheet.Columns.ColumnWidth = 5 ActiveWindow.Zoom = 10 intS = 2 lngZ = 0 On Error GoTo FEHLER For r = 0 To 255 Step 10 For g = 0 To 255 Step 7 For b = 0 To 255 Step 5 lngZ = lngZ + 1 strRGB = r & "|" & g & "|" & b 'Cells(lngZ, intS) = strRGB Cells(lngZ, intS).Interior.Color = RGB(r, g, b) If lngZ Mod 256 = 0 Then intS = intS + 1 lngZ = 0 End If Next Next Next MsgBox Format(Now - datBeg, "mm:ss") Exit Sub FEHLER: MsgBox "Abbruch bei " & strRGB & vbNewLine & "Fehler: " & Err.Number & vbNewLine & Err.Description End Sub

Die zweite Variante ist wahrscheinlich die optisch schönste, die ergibt solche Verläufe:

Alternativ geht es auch mit der Tastenkombination Strg und ` (Graviszeichen, Taste rechts neben � mit Umschalttaste drücken).

Sollen nur ausgewählte Formeln gedruckt werden, kann man als erstes in die Zelle ein Hochkomma (') eingeben, dann wird der Inhalt der Zelle als Text behandelt. Das empfiehlt sich übrigens auch dann, wenn eine längere Formel nicht beendet ist, aber die Mappe geschlossen werden soll.

Ab Excel 365

Sollen die Formeln zusätzlich zu den Ergebnissen gedruckt werden, können die mit der Funktion FORMELTEXT() angezeigt werden:

=FORMELTEXT(A1)

Angenommen in Spalte A und B stehen Zahlen, in Spalte C sollen jeweils die Summenformeln stehen. Die Zeilenanzahl wird durch die Spalte B bestimmt.

Variante mit englischer Syntax:

Sub Formeleinfuegen() Dim lngI As LongPtr For lngI = 1 To Cells(Rows.Count, 2).End(xlUp).Row ActiveSheet.Range("C" & lngI).Formula = "=SUM(A" & lngI & ",B" & lngI & ")" Next End Sub

Variante mit deutscher Syntax:

Sub Formeleinfuegen1() Dim lngI As LongPtr For lngI = 1 To Cells(Rows.Count, 2).End(xlUp).Row ActiveSheet.Range("C" & lngI).FormulaLocal = "=SUMME(A" & lngI & ";B" & lngI & ")" Next End Sub

Zum Verständnis: Das führende Hochkomma gehört zum Format der Zelle, nicht zum Inhalt.

Am einfachsten ist sicher, das Format einer anderen Zelle zu übertragen.

Dazu wird eine leere Zelle benötigt, die genau so formatiert wird, wie es bei den Zellen mit den Hochkommas der Fall ist. Damit sind also Farben, Rahmen, Schriftformat und ggf. Zahlenformat gemeint. Aber Vorsicht: Nicht das Format einer Zelle mit Hochkomma auf diese Zelle übertragen, sondern diese Zelle manuell formatieren!

Das Formatieren kann natürlich entfallen, wenn es bei den Zellen mit den Hochkommas nur um die Inhalte geht, wenn es sich also um reine Daten handelt, die nicht zur Ansicht oder zum Druck vorgesehen sind.

Nun die so formatierte Zelle aktivieren (anklicken), anschlie�end im Ribbon Start auf den Pinsel zum Format übertragen klicken und sofort über die Zellen ziehen, in denen die zu entfernenden Hochkommas sind.

Alternativ geht das auch per VBA. M2 ist die manuell formatierte Zelle, in A2:A20 sind die zu entfernenden Hochkommas:

Range("M2").Copy Range("A2:A20").PasteSpecial Paste:=xlPasteFormats

Sollten dann noch Formeln angezeigt werden oder Zahlen als Text, kann dieser Code mit dem Code in Textzahl zu Zahl kombiniert werden.

---

Ã?hnlich ist eine Alternative, bei der Excel zum Rechnen gezwungen wird. Dazu wird eine Zelle mit einer 1 kopiert und der zu ändernde Bereich per Inhalte einfügen ▸ Multiplizieren damit multipliziert:

Range("IV10000") = "1" Range("IV10000").Copy 'Bereich anpassen: Range("A2:A16").PasteSpecial Paste:=xlAll, Operation:=xlMultiply Range("IV10000").ClearContents

---

Au�erdem können die Hochkommas so entfernt werden:

1. Eine Hilfsspalte anlegen, die später wieder gelöscht werden kann.
2. In die erste Zeile dieser Hilfsspalte einen Bezug auf die Zelle mit dem Hochkomma schreiben, z. B. =A1.
3. Diese Formel nach unten kopieren, soweit, wie sich Einträge mit Hochkommas in den Zellen befinden. Jetzt sind die Einträge doppelt - einmal mit Hochkomma und einmal als Ergebnis des Bezugs.
4. Die Zellen mit den Bezügen markieren.
5. Kopieren und gleich Bearbeiten - Inhalte einfügen - Werte wählen.
6. Da die Zellen noch markiert sind, noch einmal kopieren.
7. Die erste Zelle mit einem Hochkomma aktivieren und einfügen. Jetzt mü�ten die Hochkommas verschwunden sein und die Hilfsspalte kann nun wieder gelöscht werden.

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.	Konstante	Name
1	xlDialogActivate	Aktivieren
2	xlDialogActiveCellFont	Schrift
3	xlDialogAddinManager	Add-In-Manager
4	xlDialogAlignment	Ausrichtung
5	xlDialogApplyStyle	Formatvorlage
6	xlDialogArrangeAll	Fenster anordnen
7	xlDialogAutoCorrect	Autokorrektur
8	xlDialogBorder	Rahmen
9	xlDialogCalculation	Beschriftungsoptionen
10	xlDialogCellProtection	Zellschutz
11	xlDialogClear	Inhalte löschen
12	xlDialogColorPalette	Farboptionen
13	xlDialogColumnWidth	Spaltenbreite
14	xlDialogConditionalFormatting	Bedingte Formatierung
15	xlDialogConsolidate	Konsolidierung
16	xlDialogCopyPicture	Bild kopieren
17	xlDialogCreateNames	Namen erstellen
18	xlDialogCustomizeToolbar	Anpassen
19	xlDialogCustomViews	Ansichten
20	xlDialogDataSeries	Reihe
21	xlDialogDefineName	Namen definieren
22	xlDialogDefineStyle	Formatvorlage
23	xlDialogDeleteFormat	Zahlenformat
24	xlDialogDeleteName	Namen definieren
25	xlDialogDemote	Gruppierung
26	xlDialogDisplay	Bildschirmanzeigeoptionen
27	xlDialogEditDelete	Zellen löschen
28	xlDialogFileDelete	Datei löschen
29	xlDialogFileSharing	Arbeitsmappe freigeben
30	xlDialogFilterAdvanced	Spezialfilter
31	xlDialogFindFile	Datei suchen/öffnen
32	xlDialogFormatAuto	Autoformat
33	xlDialogFormatNumber	Zahlenformat
34	xlDialogFormulaFind	Suchen
35	xlDialogFormulaGoto	Gehe zu
36	xlDialogFormulaReplace	Ersetzen
37	xlDialogGoalSeek	Zielwertsuche
38	xlDialogImportTextFile	Textdatei importieren
39	xlDialogInsert	Zellen einfügen
40	xlDialogInsertHyperlink	Hyperlink einfügen
41	xlDialogInsertNameLabel	Beschriftungsbereiche
42	xlDialogInsertObject	Objekt einfügen
43	xlDialogInsertPicture	Bild einfügen
44	xlDialogNew	Datei - Neu
45	xlDialogOpen	Datei öffnen
46	xlDialogOptionsCalculation	Optionen: Berechnung
47	xlDialogOptionsEdit	Optionen: Bearbeitung
48	xlDialogOptionsGeneral	Optionen: Allgemein
49	xlDialogOptionsListsAdd	Optionen: Liste
50	xlDialogOptionsTransition	Optionen: Umsteigen
51	xlDialogOptionsView	Otionen: Ansicht
52	xlDialogPageSetup	Seite einrichten
53	xlDialogPasteSpecial	Inhalte einfügen
54	xlDialogPatterns	Format: Muster
55	xlDialogPrint	Drucken
56	xlDialogPrinterSetup	Druckereinrichtung
57	xlDialogProperties	Dateieigenschaften
58	xlDialogProtectDocument	Blatt schützen
59	xlDialogRoutingSlip	Mailverteiler
60	xlDialogRowHeight	Zeilenhöhe
61	xlDialogRun	Makro
62	xlDialogSaveAs	Speichern unter
63	xlDialogSelectSpecial	Inhalte auswählen
64	xlDialogSendMail	Mappe als Mail
65	xlDialogSetBackgroundPicture	Hintergrundbild
66	xlDialogSetPrintTitles	Drucktitel
67	xlDialogSort	Sortieren
68	xlDialogUnhide	Tabelle einblenden
69	xlDialogWorkbookAdd	Blatt verschieben/kopieren
70	xlDialogWorkbookName	Blatt umbenennen
71	xlDialogWorkbookNew	Tabelle usw. einfügen
72	xlDialogWorkbookProtect	Arbeitsmappe schützen
73	xlDialogZoom	Zoom

Download: integrierte_dialogfelder.xlsm

Drei Varianten:

Namen zählen ab Excel 365: dynamische Arrayformeln

Sub Namen_Zaehlen() Dim intN As Integer Dim rngZelle As Range Dim arrTemp Dim arrSammler(), lngArrSammler As Long intN = 0 lngArrSammler = 0 For Each rngZelle In Range("A1:B4").Cells arrTemp = Split(rngZelle, ", ") If UBound(arrTemp) > -1 Then For intN = 0 To UBound(arrTemp) lngArrSammler = lngArrSammler + 1 ReDim Preserve arrSammler(1 To lngArrSammler) arrSammler(lngArrSammler) = Trim(arrTemp(intN)) Next End If Next MsgBox UBound(Application.WorksheetFunction.Unique(arrSammler, 1)) End Sub

---

Namen ausgeben ab Excel 365: dynamische Arrayformeln als Matrixfunktion

Function Einzelnamen(ByRef rngRange As Range) Dim intN As Integer Dim rngZelle As Range Dim arrTemp Dim arrSammler(), lngArrSammler As Long intN = 0 lngArrSammler = 0 For Each rngZelle In rngRange.Cells arrTemp = Split(rngZelle, ", ") If UBound(arrTemp) > -1 Then For intN = 0 To UBound(arrTemp) lngArrSammler = lngArrSammler + 1 ReDim Preserve arrSammler(1 To lngArrSammler) arrSammler(lngArrSammler) = Trim(arrTemp(intN)) Next End If Next Einzelnamen = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Unique(arrSammler, 1)) End Function

In die Zelle kann dann einfach die Formel:

=Einzelnamen(A1:B8)

---

Variante für ältere Versionen

'An den Anfang des Moduls: Dim arrSammler(), lngArrSammler As Long Sub Auswerten() Dim intN As Integer, intZ As Integer Dim rngZelle As Range Dim arrTemp intN = 0 lngArrSammler = -1 For Each rngZelle In Range("A1:B4").Cells arrTemp = Split(rngZelle, ",") If UBound(arrTemp) > -1 Then For intN = 0 To UBound(arrTemp) Sammler arrTemp(intN) Next End If Next lngArrSammler = lngArrSammler + 1 MsgBox lngArrSammler End Sub Function Sammler(ByVal strName As String) Dim lngZ As Long, strTemp As String strTemp = LCase(Trim(strName)) If lngArrSammler >= 0 Then For lngZ = 0 To lngArrSammler If LCase(arrSammler(lngZ)) = strTemp Then Exit Function Next End If lngArrSammler = lngArrSammler + 1 ReDim Preserve arrSammler(lngArrSammler) arrSammler(lngArrSammler) = Trim(strName) End Function

Die Funktion prüft nur, ob der aktuelle Name bereits im Array ist und erweitert den Array. Geschmacksache - das kann natürlich auch in die eigentliche Routine.

Die gesamte Tabelle nach ungeschützten Zellen durchsuchen zu lassen würde sicher zu lange dauern. Besser ist es, den Bereich, der durchsucht werden soll, einzugrenzen und dann in einer verschachtelten Schleife alle Inhalte ungeschützter Zellen zu löschen. Das Makro wäre dann:

Sub UngeschuetztLoeschen() Dim lngZ As Long, lngZ1 As Long, lngZ2 As Long, lngS As Long, lngS1 As Long, lngS2 As Long lngZ1 = 1 'Erste Zeile mit zu löschenden Inhalten lngZ2 = 100 'Letzte Zeile mit zu löschenden Inhalten lngS1 = 1 'Erste Spalte mit zu löschenden Inhalten lngS2 = 5 'Letzte Spalte mit zu löschenden Inhalten For lngZ = lngZ1 To lngZ2 For lngS = lngS1 To lngS2 Application.StatusBar = Cells(lngZ, lngS).Address If Cells(lngZ, lngS).Locked = False Then Cells(lngZ, lngS).ClearContents Next Next Application.StatusBar = False End Sub

Oder einfach per UsedRange:

Dim rngZelle As Range For Each rngZelle In ActiveSheet.UsedRange If rngZelle.Locked = False Then rngZelle.ClearContents Next

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

---

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

Es ist nicht leicht, auf eine Variante ohne Select und Activate umzusteigen, aber es lohnt sich.

Vielleicht zunächst etwas Grundsätzliches:

Um objektorientiert zu arbeiten muss man wissen, was in Excel Objekte sind: Mappen, Tabellen, Spalten, Zeilen, Zellen, Userformen, usw.

Jedes Objekt hat Eigenschaften.
Das heiÃ?t, man kann die Frage stellen: Wie ist es? Im Vergleich zu einem Auto kann man also fragen: Wie ist die Farbe des Autos?

Jedem Objekt stehen aber auch Methoden zur Verfügung.
Dann kann man die Frage stellen: Was soll damit geschehen? Beim Auto wäre das: Was soll das Auto machen?

Immer wieder wird nach den Nachteilen von Select und Activate gefragt oder es wird darauf eingegangen. Leider wird es auch immer wieder genutzt - kein Wunder, denn selbst der Makro-Recorder zeichnet das ja so auf.

Fakt ist jedoch: Diese Anweisungen sollte man vermeiden, wo es immer geht.

Der Grund ist, dass man Blätter und Zellen immer erst aktivieren muss, wenn man mit ihnen arbeitet. Das ergibt nicht nur ein unschönes Bildschirmflackern (das man allerdings abstellen kann), sondern sorgt durch die Rechenbelastung auch dafür, dass die Routinen stark verlangsamt werden. Au�erdem spart man sich viel Code, wenn man Objekte direkt anspricht; die Programmierung wird also viel übersichtlicher.

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.

Function Quersumme(Zelle As Range) As Integer Dim intI As Integer Application.Volatile Quersumme = 0 If IsNumeric(Zelle) Then For intI = 1 To Len(Zelle) Quersumme = Quersumme + CInt(Mid(Zelle, intI, 1)) Next End If End Function

In die Zellen braucht man dann nur die Formel einzugeben:

=Quersumme(A1)

Eine interessante Lösung per Formel, die die Zeilennummern verwendet, finden Sie hier: exceltricks.blog.

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().

Sub Raus_damit() Dim strInhalt As String, lngZ1 As Long, lngZn As Long, lngZ As Long Dim intS As Integer, intI As Integer, intZ As Integer intS = 1 'Spalte A lngZ1 = 1 'Erste Zeile lngZn = 25 'Letzte Zeile For lngZ = lngZ1 To lngZn strInhalt = Cells(lngZ, intS) For intI = 1 To Len(strInhalt) intZ = Asc(Mid(strInhalt, intI, 1)) If intZ >= 123 And intZ <= 255 Then Mid(strInhalt, intI, 1) = "_" Next Cells(lngZ, intS) = strInhalt Next End Sub

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

---

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.

In E1 befindet sich der Suchbegriff.

=SUMME(INDIREKT("B"&VERGLEICH(E1;A1:A15;0)):INDIREKT("D"&VERGLEICH(E1;A1:A15;0)))

---

Dynamische Arrayfunktion (ab Excel 365)

Einsatz dynamischer Arrayfunktionen

Sub Aufteilen_Filter() Dim lngZ As LongPtr, lngLZ As LongPtr, intZ As Integer Dim strAktBlatt As String, strFormel As String Dim wksNeu As Worksheet Dim varFilt, varNamen, varName strAktBlatt = "Mitarbeiter" lngLZ = Cells(Rows.Count, 3).End(xlUp).Row varNamen = Application.WorksheetFunction.Unique(Range("C2:C" & lngLZ)) If IsArray(varNamen) Then For Each varName In varNamen strFormel = "=FILTER(" & strAktBlatt & "!C2:G" & lngLZ & "," & strAktBlatt & "!C2:C" & lngLZ & "=""" & varName & """)" varFilt = Application.Evaluate(strFormel) If IsArray(varFilt) Then Set wksNeu = Worksheets.Add(after:=Sheets(Sheets.Count)) wksNeu.Name = varName Sheets(strAktBlatt).Range("C1:G1").Copy wksNeu.Range("C1") lngZ = 1 If UBound(varFilt) = Application.WorksheetFunction.CountA(varFilt) Then lngZ = lngZ + 1 For intS = 1 To UBound(varFilt) wksNeu.Cells(lngZ, intS + 2) = varFilt(intS) '+2 weil Spalte C Next Else For intZ = 1 To UBound(varFilt) lngZ = lngZ + 1 For intS = 1 To 5 wksNeu.Cells(lngZ, intS + 2) = varFilt(intZ, intS) Next Next End If End If Next End If End Sub

---

Schleife

Vor Excel 365 funktioniert die Variante mit den dynamischen Arrayfunktionen noch nicht. Deshalb hier noch eine ältere Möglichkeit:

Die Routine duchläuft die Spalte der Mitarbeiternamen von oben nach unten. Mit Hilfe der Z�HLENWENN-Funktion wird geprüft, ob sich unterhalb der gerade durchlaufenen Zelle der Name des Mitarbeiters nochmals befindet. Wenn nicht, wird ein neues Blatt mit dem Namen des Mitarbeiters angelegt und es werden die Spaltenüberschriften eingefügt.

Zum Schluss werden die Daten zu den Mitarbeitern auf deren Blättern eingetragen.

Sub Aufteilen_Schleife() Dim lngZ As Long, lngLZ As Long, intAnzahl As Integer Dim lngAktZeile As Long Dim strAktBlatt As String, strName As String Dim ints, intAnzahlTB, intAnzahlSpalten As Integer Dim objNeuBlatt As Worksheet Dim lngErsteZeile As Long Dim strSpalte As String 'Hier anpassen: lngErsteZeile = 2 strSpalte = "C" strAktBlatt = ActiveSheet.Name lngLZ = Range(strSpalte & 65536).End(xlUp).Row 'Blätter mit den Spaltenüberschriften erstellen: For lngZ = lngErsteZeile To lngLZ If Sheets(strAktBlatt).Range(strSpalte & lngZ) <> "" Then intAnzahl = Application.WorksheetFunction.CountIf(Sheets(strAktBlatt).Range(strSpalte & lngZ + 1 & ":" & strSpalte & "65536"), Sheets(strAktBlatt).Range(strSpalte & lngZ)) If intAnzahl = 0 Then Set objNeuBlatt = Worksheets.Add(after:=Sheets(Sheets.Count)) objNeuBlatt.Name = Sheets(strAktBlatt).Range(strSpalte & lngZ) For ints = 1 To Sheets(strAktBlatt).Cells(1, Columns.Count).End(xlToLeft).Column objNeuBlatt.Cells(1, ints) = Sheets(strAktBlatt).Cells(1, ints) Next ints End If End If Next lngZ '�bernahme der Daten auf die einzelnen Blätter: intAnzahlSpalten = Sheets(strAktBlatt).Cells(1, Columns.Count).End(xlToLeft).Column For lngZ = lngErsteZeile To lngLZ strName = Sheets(strAktBlatt).Range(strSpalte & lngZ) If strName <> "" Then lngAktZeile = Sheets(strName).Range(strSpalte & 65536).End(xlUp).Row + 1 Sheets(strName).Range(Sheets(strName).Cells(lngAktZeile, 1), Sheets(strName).Cells(lngAktZeile, intAnzahlSpalten)).Value = _ Sheets(strAktBlatt).Range(Sheets(strAktBlatt).Cells(lngZ, 1), Sheets(strAktBlatt).Cells(lngZ, intAnzahlSpalten)).Value End If Next lngZ End Sub

=A2&" "&RECHTS(A1; LÃ?NGE(A1)-FINDEN(" ";A1))

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.

Es ist das Problem, das häufig auftritt, wenn die Daten aus Textdateien oder aus dem Internet kommen. Dann sind scheinbar Zahlen enthalten, die aber in den Zellen links stehen - ein Indiz dafür, dass die Daten nicht als Zahlen, sondern als Texte (String) erkannt wurden. Man kann natürlich die Zellen rechtsbündig formatieren, was aber das grundlegende Problem nicht löst. Da es sich immer noch um Texte handelt, können bei Berechnungen Fehler auftreten.

Nun könnte man nacheinander jede Zelle aktivieren, mit F2 den Eingabemodus aufrufen und gleich wieder Enter drücken. Dadurch würde Excel i. d. R. die Zahlen als solche erkennen. Bei sehr vielen Zellen dürfte das aber eine zeitraubende Angelegenheit sein.

Hier ist ein Beispiel, das für die Lösung den Excel-internen Befehl Inhalte einfügen - Multiplikation verwendet. Nehmen wir an, in A1 steht die Ziffer 1. Dann kann man die Textzahlen in B1:B21 umwandeln mit:

Range("A1").Copy Range("B1:B21").PasteSpecial Operation:=xlMultiply, SkipBlanks:=True

Sind Hochkommas im Spiel, sehen Sie sich bitte Hochkomma (') entfernen an.

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

---

Formel übergelaufen

---

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

Application.Volatile

1. Die ganze Tabelle markieren,
2. Kopieren,
3. neue Tabelle aktivieren,
4. A1 aktivieren,
5. Inhalte einfügen,
6. Transponieren ankreuzen.

Dynamische Arrayformel

Ab Excel 365 kann die Tabelle auch einfach per Formel gedreht werden. Dazu die Funktion MTRANS() verwenden und den Bereich der Tabelle angeben:

=MTRANS(E1:I3)

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.

SVERWEIS()

=SVERWEIS(MAX(A:A);A:B;2;0)

---

Ab Excel 365: FILTER()

In C1 steht A3:B10, also soll der Wert aus A1 in die Zellen im Bereich A3:B10 kopiert werden.

Beispiel 1:

Range(Range("C1")) = Range("A1")

Beispiel 2:

Range("A1").Copy Range(Range("C1")).PasteSpecial Paste:=xlPasteValues

Indem man einfach die Schriftfarbe auf die Hintergrundfarbe setzt. Diese Routine setzt die Schriftfarbe der festgelegten Zellen auf die Hintergrundfarbe, druckt und setzt die Schriftfarbe wieder zurück:

Sub Drucken() Dim arrZellen(), arrSammler(), intI As Integer 'Hier die Zellen eintragen, deren Inhalte nicht gedruckt werden sollen: arrZellen = Array("B5", "C10", "C15", "D20", "E4", "E6", "E12") ReDim Preserve arrSammler(2, UBound(arrZellen)) For intI = 0 To UBound(arrZellen) arrSammler(0, intI) = arrZellen(intI) arrSammler(1, intI) = Range(arrZellen(intI)).Font.Color arrSammler(2, intI) = IIf(Range(arrZellen(intI)).Interior.ColorIndex = -4142, -4142, Range(arrZellen(intI)).Interior.Color) Range(arrZellen(intI)).Font.Color = Range(arrZellen(intI)).Interior.Color Next ActiveSheet.PrintOut For intI = 0 To UBound(arrZellen) Range(arrSammler(0, intI)).Font.Color = arrSammler(1, intI) If arrSammler(2, intI) = -4142 Then Range(arrSammler(0, intI)).Interior.ColorIndex = -4142 Else Range(arrSammler(0, intI)).Interior.Color = arrSammler(2, intI) End If Next End Sub

Hier werden zwei Varianten vorgestellt, bei denen Werte in mehrere Zellen in einer Zeile eingegeben werden können und diese als Filterkriterium dienen. Die Zellen, in die die Filterkriterien eingegeben werden können, sind hier A2:G2, also die ersten sieben Zellen in Zeile 2. Die Tabelle mit den zu filternden Werten ist darunter von A5:Gx.

In beiden Fällen im VBA-Editor auf die entsprechende Tabelle doppelklicken und den Code dort einfügen.

Ein Kriterium

Im ersten Beispiel richtet sich der Filter nach nur einem Kriterium, also einer Zelle in A2:G2. Wenn also z. B. in B2 etwas eingegeben wird, soll die Tabelle nach dem Eintrag in B2 gefiltert werden - etwaige Eintragungen in anderen Zellen in Zeile 2 werden ignoriert bzw. gelöscht:

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim lngLZ As LongPtr, intS As Integer, intSAkt As Integer, bolEvent As Boolean If Target.Row <> 2 Or Target.Column > 7 Then Exit Sub lngLZ = Cells(Rows.Count, 1).End(xlUp).Row If ActiveSheet.AutoFilterMode = True Then If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData ActiveSheet.Range("A4:G" & lngLZ).AutoFilter End If bolEvent = Application.EnableEvents Application.EnableEvents = False For intS = 1 To 7 If intS <> Target.Column Then Cells(2, intS).ClearContents Next Application.EnableEvents = bolEvent If Target <> "" Then ActiveSheet.Range("A4:G" & lngLZ).AutoFilter Field:=Target.Column, Criteria1:=Range(Target.Address) End Sub

Nach der Eingabe werden zunächst alle Zeilen eingeblendet und der Autofilter ausgeschaltet, falls er gesetzt ist. Anschlie�end wird ausgeschaltet, dass die Tabelle auf Ereignisse reagiert (da es sonst zu Endlosschleifen kommen könnte) und die Inhalte der anderen Zellen in Zeile 2 werden gelöscht. Danach wird der Autofilter auf der Basis der aktuellen Eingabe gesetzt.

---

Mehrere Kriterien

In der zweiten Variante sind in Zeile 2 mehrere Einträge möglich und der Autofilter wird auf der Basis dieser Einträge gesetzt. Das Vorgehen entspricht ansonsten der ersten Variante.

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim lngLZ As LongPtr, intS As Integer If Target.Row <> 2 Or Target.Column > 7 Then Exit Sub lngLZ = Cells(Rows.Count, 1).End(xlUp).Row With ActiveSheet If .AutoFilterMode = True Then If .FilterMode = True Then .ShowAllData .Range("A4:G" & lngLZ).AutoFilter End If For intS = 1 To 7 If .Cells(2, intS) <> "" Then .Range("A4:G" & lngLZ).AutoFilter Field:=intS, Criteria1:=.Cells(2, intS).Value End If Next End With End Sub

---

Eingabe nur in A2 - ältere Variante mit weniger Funktionalität

Im VBA-Editor auf die Tabelle doppelt klicken, in der es funktionieren soll. Anschlie�end in das Modul einfügen:

Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address <> "$A$2" Then Exit Sub ActiveSheet.Range("A4:B" & Cells(Rows.Count, 1).End(xlUp).Row).AutoFilter If Range("A2") <> "" Then ActiveSheet.Range("A4:B" & Cells(Rows.Count, 1).End(xlUp).Row).AutoFilter Field:=1, Criteria1:=Range("a2") End If End Sub

Bei den Workbook-Ereignissen trifft eingeschränkt das zu, was bei den Application-Ereignissen steht. Der markanteste Unterschied ist, dass Workbook-Ereignisse - wie der Name schon sagt - nur die Elemente der Mappe mit dem Code betreffen und dass wir hier kein Klassenmodul einfügen müssen.

Im Visual-Basic-Editor (Alt & F11) reicht es, im Projektfenster auf Diese Arbeitsmappe doppelzuklicken und dann von Allgemein auf Workbook zu wechseln. Nun stehen im rechten Drop-Down-Feld die Ereignisse zur Verfügung:

Parameterinfo

Bei verschiedenen Prozeduren werden auch Parameter übergeben. Diese verhalten sich wie folgt:

Cancel:	Die Boolsche Variable steht standardmä�ig auf False. Setzt man sie auf True, wird das Ereignis nicht mehr ausgeführt. So kann man z. B. das Schlie�en der Arbeitsmappe verhindern, indem man Cancel = True innerhalb der Prozedur BeforeClose setzt.
Sh:	Sh steht für das aktive Tabellenblatt. Man beachte auch die Eigenschaften und Methoden, die Sh zur Verfügung stehen. So erhält man z.B. über Sh.Name den Namen des aktiven Blattes.
Target:	Target steht für den aktiven Bereich und wird häufig dazu benutzt, um den Bereich zum Ausführen eines bestimmten Makros zu bestimmen. So kann man mit: If Target.Address = $A$1 erreichen, da� das Makro nur dann ausgeführt wird, wenn die Zelle A1 aktiv ist.
Wn:	Stellt das aktive Fenster dar.

Ereignisse:

Workbook_Activate

Tritt ein, nachdem die Arbeitsmappe aktiviert wurde.

Workbook_AddinInstall

Tritt ein, wenn die Arbeitsmappe als Add-In installiert wurde.

Workbook_AddinUninstall

Tritt ein, wenn die Arbeitsmappe als Add-In deinstalliert wurde.

Workbook_BeforeClose(Cancel As Boolean)

Tritt ein, bevor die Arbeitsmappe geschlossen werden soll.

Workbook_BeforePrint(Cancel As Boolean)

Tritt ein, wenn die Arbeitsmappe ausgedruckt werden soll. Man benutzt diese Prozedur häufig zum Aktualisieren der Daten vor dem Drucken.

Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Tritt ein, wenn die Arbeitsmappe gespeichert werden soll. Man benutzt diese Prozedur häufig zum Aktualisieren der Daten vor dem Speichern. SaveAsUI hat dabei den Wert True, wenn das Dialogfeld Save As angezeigt wird.

Workbook_Deactivate

Tritt ein, wenn die Arbeitsmappe deaktiviert wird, zum Beispiel beim Wechsel in eine andere Arbeitsmappe.

Workbook_NewSheet(ByVal Sh As Object)

Tritt ein, wenn ein neues Blatt eingefügt wird.

Workbook_Open

Tritt ein, wenn die Arbeitsmappe geöffnet wurde. Diese Prozedur wird häufig dazu verwendet, um Werte zu initialisieren, welche später in der BeforeClose-Prozedur wieder entfernt werden sollten.

Workbook_SheetActivate(ByVal Sh As Object)

Tritt ein, wenn ein Blatt aktiviert wird, also bei einem Blattwechsel.

Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)

Tritt bei einem Doppelklick auf einem Tabellenblatt ein.

Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)

Tritt bei einem Klick mit der rechten Maustaste in einem Tabellenblatt ein.

Workbook_SheetCalculate(ByVal Sh As Object)

Tritt ein, wenn Zellen eines Blattes neu berechnet werden. Dieses Ereigniss tritt auch dann ein, wenn sich ein Bezug verändert. Z. B. in B1 steht "= A1" und A1 wird verändert, so wird die Prozedur ausgeführt, da B1 neu berechnet wird.

Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)

Tritt ein, wenn mindestens eine Zelle in einem Blatt geändert wurde. Leider gibt es immer wieder Probleme bei externen Bezügen, wenn z.B. Daten per DDE geholt werden. Man sollte dann prüfen, ob man nicht mit Calculate zum Ergebnis kommt, indem man einen Bezug zur DDE-Zelle herstellt (=A1).

Workbook_SheetDeactivate(ByVal Sh As Object)

Tritt ein, wenn ein Blattwechsel stattgefunden hat.

Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)

Tritt ein, wenn sich die Markierung in einem Blatt ändert.

Workbook_WindowActivate(ByVal Wn As Excel.Window)

Tritt bei einem Fensterwechsel ein.

Workbook_WindowDeactivate(ByVal Wn As Excel.Window)

Tritt bei einem Fensterwechsel ein.

Workbook_WindowResize(ByVal Wn As Excel.Window)

Tritt bei einer Veränderung der Fenstergrö�e ein.

Wie der Name schon sagt, geht es bei den Worksheet-Ereignissen um Aktivitäten in Bezug auf das einzelne Tabellenblatt.

Im Visual-Basic-Editor (Alt & F11) wird dazu im Projektfenster auf die jeweilige Tabelle doppelt geklickt und dann von "Allgemein auf "Worksheet gewechselt. Nun stehen im rechten Drop-Down-Feld die Ereignisse zur Verfügung.

Im Gegensatz zu den Workbook-Ereignissen, welche bei allen Tabellenblättern auftreten, sind die Worksheet-Ereignisse an das Tabellenblatt gebunden, indem sie stehen.

Parameterinfo

Bei verschiedenen Prozeduren werden auch Parameter übergeben. Diese verhalten sich wie folgt:

Cancel:	Die Boolsche Variabel steht standardmä�ig auf False. Setzt man sie auf True, wird das Ereignis nicht mehr ausgeführt. So kann man z. B. das �ffnen des Auswahlmenüs verhindern, indem man Cancel = True innerhalb der Prozedur "BeforeRightClick setzt.
Target:	Target steht für den aktiven Bereich und wird häufig dazu benutzt, um den Bereich zum Ausführen eines bestimmten Makros zu bestimmen. So kann man mit: If Target.Address = $A$1 erreichen, da� das Makro nur dann ausgeführt wird, wenn die Zelle A1 aktiv ist.

Ereignisse:

Worksheet_Activate

Tritt ein, wenn das Tabellenblatt aktiviert wird, also Blattwechsel zu diesem Blatt hin.

Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)

Tritt bei einem Doppelklick innerhalb der Tabelle ein.

Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)

Tritt bei einem Klick mit der rechten Maustaste innerhalb der Tabelle ein.

Worksheet_Calculate

Tritt ein, wenn Zellen dieses Blattes neu berechnet werden. Dieses Ereignis tritt auch dann ein, wenn sich ein Bezug verändert. Z. B. in B1 steht "= A1" und A1 wird verändert, so wird die Prozedur ausgeführt, da B1 neu berechnet wird.

Worksheet_Change (ByVal Target As Excel.Range)

Tritt ein, wenn mindestens eine Zelle im Tabellenblatt geändert wurde. Leider gibt es immer wieder Probleme bei externen Bezügen, wenn z. B. Daten per DDE geholt werden. Man sollte dann prüfen, ob man nicht mit dem Calculate zum Ergebnis kommt, indem man einen Bezug zur DDE-Zelle herstellt (=A1).

Worksheet_Deactivate

Tritt ein, wenn man von diesem Blatt aus zu einem anderem wechselt.

Worksheet_SelectionChange(ByVal Target As Excel.Range)

Tritt ein, wenn sich die Markierung im Tabellenblatt ändert.

Die benutzerdefinierten Funktionen in ein Standardmodul:

---

Getrennte Funktionen für Euro und Cent

Function WEuro(Zelle) If Not IsNumeric(Zelle) Then WEuro = "" Else WEuro = Fix(Zelle) End Function Function WCent(Zelle) If Not IsNumeric(Zelle) Then WCent = "" Else WCent = (Zelle - Fix(Zelle)) * 100 End Function

In die Zellen braucht man dann nur die Formeln einzugeben:

= WEuro(A1) = WCent(A1)

---

Eine Funktionen mit Wahlparameter für Euro oder Cent

Function EuroCent(Zelle, was) EuroCent = "" If IsNumeric(Zelle) Then EuroCent = IIf(was = 1, Fix(Zelle), (Zelle - Fix(Zelle)) * 100) End If End Function

In die Zellen käme dann
=eurocent(A1;1) für den Eurobetrag,
=eurocent(A1;2) für die Cent.

---

Dynamische Arrayformel mit Matrixfunktion (ab Excel 365)

In die Zelle wird dazu eingetragen:

=EuroCent_Beide(D1)

Die Schleife sucht so lange nach Zellen, die jeweils eine 1 enthalten, bis keine mehr gefunden wird:

Sub Loeschen() Dim rngGef As Range Do Set rngGef = Columns(1).Find(What:="1", LookAt:=xlWhole) If Not rngGef Is Nothing Then Rows(rngGef.Row).Delete Loop While Not rngGef Is Nothing End Sub

Dieser Code ersetzt das unsichtbare Zeichen mit einem Mal in allen Zellen der aktiven Tabelle:

Sub ZeilenumbruecheErsetzen() ActiveSheet.Cells.Replace Chr(10), " " End Sub

Bei der Eingabe einer Zeit >= 10 000 wird diese als Text behandelt, man kann damit auch nicht weiterrechnen. Ist das Ergebnis einer Formel aber >= 10 000, ist das für Excel eine Zeit.

Um mit Zeitwerten über 10 000 Stunden rechnen zu können, müssen diese also nur auf mehrere Zellen verteilt und addiert werden. Mit dieser Summe kann problemlos weitergerechnet werden.

Soll das wirklich geschehen, geht es mit dem folgenden Code:

Application.SendKeys ("{F2}")

Allerdings wird bei SendKeys dummerweise der Numblock ausgeschaltet, so dass diese Tasten dann als Richtungstasten statt der Zahleneingaben funktionieren.

Generell ist es besser, Zellen Inhalte direkt zuzuweisen. Dann funktionieren etwaige Makros auch weiter, was im Bearbeitungsmodus unterbrochen wird. Bei automatisierten Eintragungen oder Ã?nderungen ist es eigentlich nie notwendig, in den Bearbeitungsmodus zu wechseln.

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.

Mit diesem Add-In können die gewünschten Zellen markiert und anschließend auf jeden verfügbaren Drucker gedruckt werden.

Download: zellen_beim_druck_ausblenden.xlam

In ein Standardmodul folgende benutzerdefinierte Funktion:

Function Farbenzaehlen(Bereich) Dim Zelle As Object Application.Volatile Farbenzaehlen = 0 For Each Zelle In Bereich If Zelle.Interior.ColorIndex <> xlNone Then Farbenzaehlen = Farbenzaehlen + 1 Next End Function

Allerdings muss beachtet werden, dass eine Neuberechnung der Formel nicht erfolgt, wenn eine Hintergrundfarbe geändert wird. Hierzu muss irgendwo eine Eingabe erfolgen oder F9 gedrückt werden.

Sollte eine sofortige Neuberechnung wichtig sein, kann im Klassenmodul der Tabelle oder im Klassenmodul DieseArbeitsmappe das SelectionChange-Ereignis abgefangen werden:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.Calculate End Sub

Oder für die Mappe:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Application.Calculate End Sub

Allerdings wird dann wirklich bei jeder Bewegung neu berechnet, was sich bei vielen Formeln mit einer gewissen Trägheit bemerkbar machen kann.

Dazu gibt es verschiedene Möglichkeiten.

Direkt in Zellen eintragen

In der ersten Variante erfolgt die Arbeit direkt an den Zellen, weil hier die Funktionen Finden und Sortieren von Excel genutzt werden. Funktionen, die Excel zur Verfügung stellt, sind i. d. R. recht schnell, so dass das in diesem Fall sicher die kürzere und schnellere Variante ist:

Sub Zufall() Dim intWert As Integer, varWieviele, intI As Integer Dim bolVorhanden As Boolean, rngGef As Range varWieviele = InputBox("Wieviele Zahlen sollen erzeugt werden?", "Anzahl", 6) If Not IsNumeric(varWieviele) Then Exit Sub If varWieviele > 15 Then Exit Sub Sheets("Tab1").Range("A1:O1").ClearContents For intI = 1 To varWieviele intWert = Int((49 * Rnd) + 1) If intI = 1 Then Sheets("Tab1").Cells(1, intI) = intWert Else Do bolVorhanden = False Set rngGef = Range(Cells(1, 1), Cells(1, intI - 1)).Find(intWert) If Not rngGef Is Nothing Then bolVorhanden = True intWert = Int((49 * Rnd) + 1) End If Loop While bolVorhanden = True Sheets("Tab1").Cells(1, intI) = intWert End If Next Sheets("Tab1").Range("A1:O1").Sort Key1:=Sheets("Tab1").Range("A1"), Order1:=xlAscending, Orientation:=xlLeftToRight End Sub

Kern des Codes ist eine Schleife, die so lange läuft, wie eine Zufallszahl nicht mehr in den bisherigen Zufallszahlen gefunden wird. Erst dann wird sie als neue Zufallszahl verwendet.

Weiteres Beispiel - Schleife statt Find:

Sub Zufall() Dim intAnzahl As Integer, intMax As Integer, intMin As Integer Dim intWert As Integer, intI As Integer, intN As Integer Dim bolVorhanden As Boolean intAnzahl = 10 intMax = 49 intMin = 1 'alte Zahlen löschen Range(Cells(1, 2), Cells(intAnzahl, 2)).ClearContents Cells(1, 2) = Int((intMax * Rnd) + intMin) '1. Zahl erzeugen For intI = 2 To intAnzahl 'nächste Zahlen erzeugen Do bolVorhanden = False intWert = Int((intMax * Rnd) + intMin) For intN = 1 To intI 'Kontrolle ob schon vorhanden If Cells(intN, 2) = intWert Then bolVorhanden = True Exit For End If Next Loop While bolVorhanden = True Cells(intI, 2) = intWert 'Zahl eintragen Next End Sub

---

Erst Array, zum Schluss in Zellen

Manchmal kann die Arbeit mit Zellen aber auch von Nachteil sein. Deshalb ist hier der Vollständigkeit halber noch ein Beispiel, in dem Herangehensweisen mit einem Array aufgezeigt werden:

Sub Zufall1() Dim intWert As Integer, intI As Integer, intN As Integer, varWieviele Dim bolVorhanden As Boolean, bolSortiert As Boolean Dim arrZahlen() varWieviele = InputBox("Wieviele Zahlen sollen erzeugt werden?", "Anzahl", 6) If Not IsNumeric(varWieviele) Then Exit Sub If varWieviele > 15 Then Exit Sub ReDim Preserve arrZahlen(varWieviele) For intN = 0 To varWieviele - 1 intWert = Int((49 * Rnd) + 1) If intN = 0 Then arrZahlen(intN) = intWert Else Do bolVorhanden = False For intI = 0 To intN If arrZahlen(intI) = intWert Then bolVorhanden = True intWert = Int((49 * Rnd) + 1) Exit For End If Next Loop While bolVorhanden = True arrZahlen(intN) = intWert End If Next Do bolSortiert = True For intN = 0 To varWieviele - 2 If arrZahlen(intN + 1) < arrZahlen(intN) Then bolSortiert = False intWert = arrZahlen(intN + 1) arrZahlen(intN + 1) = arrZahlen(intN) arrZahlen(intN) = intWert End If Next Loop While bolSortiert = False Sheets("Tab1").Range("A1:O1").ClearContents For intN = 0 To varWieviele - 1 Sheets("Tab1").Cells(1, intN + 1) = arrZahlen(intN) Next End Sub

Das gesamte Erstellen der Zufallszahlen - bis hin zum Sortieren - erfolgt zunächst in einem Array. Auch hier erfolgt die Prüfung auf Doppelungen. Aber es ist zu sehen, dass dafür eine weitere Schleife eingebaut ist. Eine Funktion wie in PHP in_array() wäre da natürlich günstiger.

Auch zum Sortieren wird die innere Schleife so lange durchlaufen, bis im Array das nächste Element nicht kleiner als das gerade durchlaufene Element ist.

Erst ganz zum Schluss wird der fertige Array in die Zellen übernommen.

Die zweite Variante hat den Vorteil, dass sie beliebig - und unabhängig von Zellen - eingesetzt werden kann. Sie kann auch als eigenständige Funktion erstellt werden, die dann den Array mit den Zufallszahlen zurückgibt. So könnte die Funktion von überall aufgerufen werden; in die Zellen würde dann das Ergebnis eingetragen.

Oft stö�t man bei Schleifen, die Zellen lesen und schreiben, auf das Problem, dass die Laufzeit enorm steigt. Deshalb sollte zumindest in Betracht gezogen werden, das Ganze mit Arrays zu erledigen und die Zellzugriffe auf ein Minimum zu beschränken.

---

Dynamische Arrayformel mit Matrixfunktion (ab Excel 365)

Natürlich kann das auch als Matrixfunktion für eine dynamische Arrayformel erstellt werden. Die Funktion erstellt einen Array mit eindeutigen Zahlen. Zum Schluss wird mit der Arrayfunktion SORTIEREN() sortiert und der Array ausgegeben.

Function Zufallszahlen_Eindeutig(ByVal intAnzahl As Integer, ByVal intMin As Integer, ByVal intMax As Integer) Dim intWert As Integer, intI As Integer, intN As Integer Dim bolVorhanden As Boolean, arrZahlen() Application.Volatile ReDim Preserve arrZahlen(1 To intAnzahl) For intN = 1 To intAnzahl intWert = Int((intMax * Rnd) + intMin) If intN = 1 Then arrZahlen(intN) = intWert Else Do bolVorhanden = False For intI = 1 To intN If arrZahlen(intI) = intWert Then bolVorhanden = True intWert = Int((intMax * Rnd) + intMin) Exit For End If Next Loop While bolVorhanden = True arrZahlen(intN) = intWert End If Next Zufallszahlen_Eindeutig = Application.WorksheetFunction.Sort(arrZahlen, 1, 1, 1) End Function

In die Zelle kommt einfach:

=Zufallszahlen_Eindeutig(Anzahl;Minimum;Maximum)

=Zufallszahlen_Eindeutig(5;1;49)

Sollen die Zahlen untereinander erscheinen, kann die Funktion in MTRANS() gesetzt werden:

=MTRANS(Zufallszahlen_Eindeutig(5;1;49))

Die Funktion ZUFALLSMATRIX() klingt danach, als ob sie die Aufgabe auch erfüllen könnte. Jedoch hat sie bei dieser Aufgabenstellung den gro�en Nachteil, dass sie sehr häufig mehrfach vorhandene Zahlen erzeugt. Das hei�t, dass man so oft berechnen lassen müsste, bis jede Zahl eindeutig ist - und das kann etwas dauern.

Apropos eindeutig: Mit der Funktion EINDEUTIG() könnte natürlich geprüft werden, ob eindeutige Zufallszahlen vorliegen. Allerdings ist die Funktion manchmal schneller als die Sortieren-Funktion, so dass letztere Funktion noch rechnet, wenn EINDEUTIG() schon fertig ist. Das führt dann zum bekannten Fehler �BERLAUF.