Datenschutzerklärung


Direktnachricht



Ihre Software
Details
Excel/VBA 🔍
Add-Ins

Suche in Beispielen und Tipps zu Excel und VBA

Suchbegriff(e) mit Leerzeichen getrennt:

Anleitung: Rechnung erstellenFormellösung

Kategorie: Tabelle ▸ Zellen

(Tipp 207) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich mit Formeln eine Rechnung erstellen?

Du hast eine Tabelle namens "Rechnung" und eine Tabelle namens "Artikel". Auf der Tabelle "Artikel" befinden sich ab A2 die Artikelnummern (hier fortlaufend numeriert), ab B2 die Artikel und ab C2 die Einzelpreise. Auf dem Blatt "Rechnung" wird die Rechnung erstellt.:

  1. In A20 bis A30 sollen die Nummern der gekauften Artikel eingetragen werden.
  2. In B20 bis B30 wird die Anzahl der gekauften Artikel eingetragen.
  3. In C20 bis C30 sollen automatisch die Artikel erscheinen. Dazu kannst Du die Formel verwenden (in einer Zeile): =WENN(ISTNV(SVERWEIS($A20;Artikel!$A$2:$C$28;2));""; SVERWEIS($A20;Artikel!$A$2:$C$28;2))
  4. In D20 bis D30 sollen die dazugehörigen Einzelpreise eingelesen werden. Die Formel dazu (in einer Zeile): =WENN(ISTNV(SVERWEIS($A20;Artikel!$A$2:$C$28;3));""; SVERWEIS($A20;Artikel!$A$2:$C$28;3))
  5. In E20 bis E30 sollen die Preise der gekauften Artikel errechnet werden, die Formel: =WENN(D20="";"";B20*D20)
  6. In E31 soll Netto ausgerechnet werden: =SUMME(E20:E30)
  7. MwSt. in E32: =E31*16%
  8. Brutto in E33: =E31+E32

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

Kategorie: Steuerelemente ▸ Userform

(Tipp 76) Nachricht zum Beitrag an Autor Nach oben

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

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

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

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

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

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

Klassenmodul der Userform: Basis für den Code

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

Private Sub CommandButton2_Click() Unload Me End Sub

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

Einlesen der Daten aus der Tabelle

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

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

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

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

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

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

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

Details zu gewähltem Listeneintrag anzeigen

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

Private Sub ListBox1_Click() End Sub

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

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

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

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

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

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

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

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

Änderungen aus der Userform in die Tabelle übernehmen

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

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

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

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

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

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

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

Neuer Eintrag

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

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

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

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

Viel Erfolg!

Arrayformeln (02): Eigene Arrayformeln, MTRANS/TRANSPOSEUDF - benutzerdefinierte FunktionFormellösungArrayfunktion/MatrixfunktionTipp

Kategorie: Arrays ▸ Arrayformeln

(Tipp 27) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich eigene Arrayformeln erstellen und nutzen?

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.

Da wir im Voraus nicht wissen, wie viele Tage der Monat hat, wird der Array „unterwegs“ immer neu dimensioniert. Dies ist nur für die letzte Dimension möglich, also erfolgt dies auch hier so. Die einzelnen Tage stecken somit in der zweiten Dimension (1 To intArr), während die drei Angaben zum Datum in der ersten Dimension sind (1 To 3). Für Tabellenblattfunktionen sollte das Zählen mit 1 statt der 0 beginnen, wozu Option Base 1 gesetzt oder - wie hier - die Deklaration entsprechend erfolgen kann.

In die Zelle kann nun eingetragen werden, wobei in B1 die Monatszahl und in B2 die Jahreszahl steht:

=monatskalender(B1;B2)

Das Ergebnis ist sofort sichtbar: An der Zelle erscheint der Kalender. Nun können einfach in B1 bzw. B2 Monat oder Jahr geändert werden - der Kalender passt sich sofort an.


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.

Arrayformeln (04): EINDEUTIG/UNIQUE (Formel + VBA)Makro/Sub/ProzedurUDF - benutzerdefinierte FunktionFormellösungArrayfunktion/MatrixfunktionTipp

Kategorie: Arrays ▸ Arrayformeln

(Tipp 116) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich die Funktion EINDEUTIG() (in VBA) nutzen?

Ab Excel 365 gibt es neben der Möglichkeit, Duplikate zu entfernen, auch eine Funktion zum Einsatz in einer Formel: EINDEUTIG(). Die Funktion sucht in einer Tabelle nach doppelten Datensätzen und gibt in der einfachen Variante jeden nur einmal aus. Weitere Informationen zu Parametern der Formel gibt es bei Microsoft: EINDEUTIG-Funktion.

Im Beispiel ist zu sehen, dass die Monate Februar und zweimal Mai im Ergebnis nur jeweils einmal erscheinen, weil diese Monate auch jeweils die gleichen Zahlen haben. Der Juni ist jedoch zweimal im Ergebnis enthalten, weil diese Datensätze unterschiedliche Zahlen haben und somit insgesamt unterschiedlich sind.

Verwendung in VBA

Auch mit VBA kann diese Funktion doppelte Datensätze ausfiltern, indem die englische Schreibweise zum Einsatz kommt:

Application.WorksheetFunction.Unique(Array)

Im Beispiel wird die Tabelle aus der Abbildung im Bereich A2:E15 verwendet. Hier sind die Datensätze bei Frau Linz identisch und zwei Datensätze bei Frau Herzig. Aus dieser Tabelle erstellen wir den Array:

arr = Range("A2:E15")

Zum Herausfiltern der doppelten Datensätze wird die Funktion eingesetzt:

arr = Application.WorksheetFunction.Unique(arr)

Weiterverarbeitung des Ergebnisarrays

Das Ergebnis ist nun in der Variablen arr der Array mit den eindeutigen Datensätzen. Dabei gibt es jedoch zwei verschiedene mögliche Fälle:

Es können (wie im Beispiel) mehrere Zeilen sein. Dann kann der Array von 1 bis zum Ubound (der hier die Anzahl der Zeilen im Ergebnis ist) mit arr(Zeile, Spalte) durchlaufen werden:

For intI = 1 To UBound(arr) MsgBox arr(intI, 1) & " " & arr(intI, 2) & ", " & arr(intI, 3) Next

Hier würde für jede Zeile eine MsgBox mit Anrede Name, Vorname erscheinen.

Es kann aber auch der Fall eintreten, dass im Ergebnis nur eine Zeile übrig bleibt, die nun als Array vorliegt. Hier enthält der Array jedoch nicht die einzelne Zeile als Arrayelement der ersten Dimension, sondern bereits die einzelnen Elemente in der ersten Ebene. In dem Fall würde ein Zugriff mit arr(Zeile, Spalte) zu einem Fehler führen, weil das Auslesen nur mit arr(Spalte) erfolgen darf.

Wenn wir im VBA-Code also beide Fälle berücksichtigen wollen, müssen wir prüfen, ob der Array aus mehreren Zeilen zu mehreren Spalten oder nur aus mehreren Spalten ohne Zeile besteht. Dazu bietet sich an, die Anzahl aller Elemente des Arrays festzustellen:

intAnzahlEl = Application.WorksheetFunction.CountA(arr)

Wenn diese Zahl gleich dem Ubound des Arrays ist, muss es sich um einen eindimensionalen handeln, weil das dann die einzelnen Spalten sind. Wenn nicht, handelt es sich um einen mehrzeiligen Array, weil es dann immer mehr Elemente als der Ubound sind (Zeilen * Spalten = intAnzahlEl).

Und so können wir in unserem Code gut die Weiche stellen - an der Stelle der MsgBoxen müsste die eigentliche Verarbeitung der Daten rein:

Sub Eindeutig_vba() Dim arr, intI As Integer, intAnzahlEl As Integer arr = Range("A2:E15") 'Zur Ausgabe von mehreren Zeilen 'arr = Range("A2:E2") 'Zur Testausgabe einer Zeile arr = Application.WorksheetFunction.Unique(arr) 'Anzahl aller(!) Elemente im Array: intAnzahlEl = Application.WorksheetFunction.CountA(arr) MsgBox "Ubound: " & UBound(arr) & vbNewLine & "Anzahl: " & intAnzahlEl If intAnzahlEl = UBound(arr) Then ' Es gibt nur eine Zeile MsgBox arr(1) & " " & arr(2) & ", " & arr(3) Else ' Mehrere Zeilen For intI = 1 To UBound(arr) MsgBox arr(intI, 1) & " " & arr(intI, 2) & ", " & arr(intI, 3) Next End If End Sub

Tipp - Sortieren:

Wenn das Ganze sortiert werden soll, kann das auch gleich am Anfang mit der integrierten Funktion erledigt werden:

arr = Application.WorksheetFunction.Unique(arr) arr = Application.WorksheetFunction.Sort(arr, 2)

In dem Beispiel wäre der frische Array nach den Namen sortiert.

Arrayformeln (07): SEQUENZ (Formel + VBA)Makro/Sub/ProzedurUDF - benutzerdefinierte FunktionFormellösungArrayfunktion/MatrixfunktionTipp

Kategorie: Arrays ▸ Arrayformeln

(Tipp 130) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich eine Reihe von Zahlen mit bestimmten Abständen erhalten?

Das Erstellen von Zahlenreihen mit bestimmten Abständen ist seit Excel 365 denkbar einfach - es gibt ja die Funktion SEQUENZ(). Die folgende Formel liefert eine Liste über 15 Zeilen in einer Spalte, beginnend mit 1 und mit einem Abstand von 1:

=SEQUENZ(15;1;1;1)

Benötigen Sie eine Reihe von Datumsangaben für Ihren 14-tägigen Urlaub, können Sie das verwenden:

=SEQUENZ(14;1;"05.02.2019";1)

Natürlich müssen die Zahlen als Datum formatiert werden.

Auch Uhrzeiten sind möglich - hier ab 08:00 mit einem Abstand von einer halben Stunde (als Zeit formatieren):

=SEQUENZ(17;1;"08:00";"00:30")


Verwendung in VBA

In VBA wird die Funktion am besten mit Application.WorksheetFunction.Sequence genutzt, um den Array mit den Zahlen zu erhalten. Beispiele:

  • arr = Application.WorksheetFunction.Sequence(10, 1, "08:00", "00:30")
  • arr = Application.WorksheetFunction.Sequence(10, 1, CDate("05.02.2019"), 1)

Verwendung/Verarbeitung des Ergebnisarrays

Bei der Verarbeitung des Ergebnisarrays ist darauf zu achten, dass die einzelnen Zahlen als Zeilen vorliegen - Ubound ist also die Zeilenzahl. Wird nur eine Spalte verwendet (immer die 1 in der Funktion), ist der Ubound auch gleichzeitig die Anzahl der Zahlen. In diesem Fall muss also auf die erste Spalte jeder Zeile zugegriffen werden:

For intI = 1 To UBound(arr) MsgBox intI & ": " & arr(intI, 1) Next

Hinweis: Bei Ausgaben von Datumsangaben und Zeiten müssen diese noch formatiert werden, zum Beispiel Format(arr(intI, 1), "hh:nn") für die Zeitangaben.

Etwas anders verhält es sich, wenn die Sequenz mehrspaltig erstellt wurde, zum Beispiel mit zwei Spalten:

arr = Application.WorksheetFunction.Sequence(10, 2, "08:00", "00:30")

Dann wird mit arr(intI, 1) nur die erste Spalte verarbeitet; bei einer Ausgabe wären das nur die vollen Stunden. In dem Fall muss dann auch auf die zweite Spalte zugegriffen werden:

MsgBox intI & ": " & Format(arr(intI, 1), "hh:nn") & vbTab & Format(arr(intI, 2), "hh:nn")

Das letzte Beispiel im Ganzen zum Testen:

Sub Sequenz_vba() Dim arr, intI As Integer arr = Application.WorksheetFunction.Sequence(10, 2, "08:00", "00:30") For intI = 1 To UBound(arr) MsgBox intI & ": " & Format(arr(intI, 1), "hh:nn") & vbTab & Format(arr(intI, 2), "hh:nn") Next End Sub

Aus Blättern einzelne Dateien erstellen

Kategorie: Add-In ▸ Dateien und Ordner

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

Wie kann ich aus Tabellenblättern einzelne Dateien erstellen?

Das Add-In fragt zunächst nach dem Ordner, in den die einzelnen Dateien gespeichert werden sollen. Dann werden die einzelnen Blätter unter deren Namen mit der Endung xlsx (kann im Code geändert werden) gespeichert, wobei geprüft wird, ob eine Datei mit diesem Namen im Ordner bereits existiert. Zum Anschluss kommt eine Erfolgsmeldung oder die Information, welche Blätter nicht gespeichert werden konnten.

Der Aufruf erfolgt im Menüband im Ribbon JL-Dateien erstellen.

Download: blaetter_speichern.xlam



Bereich als HTML-Mail versendenMakro/Sub/Prozedur

Kategorien: Netz ▸ Mail und Übergreifend

(Tipp 565) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich einen Bereich als HTML-Mail versenden?

Wie kann ich einen ausgewählten Bereich einer Exceltabelle als HTML-Mail via Outlook versenden?

Const strTempOrdner As String = "C:\Eigene Dateien\" Sub Aufruf() Mail_erstellen "info@example.org" End Sub Sub Mail_erstellen(strAdresse As String) Dim strQuelle As String Dim OutApp Dim OutMail Dim olMailItem Dim strSubject strQuelle = "$B$1:$R$58" strSubject = Range("B1") Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(olMailItem) With OutMail .To = strAdresse .CC = "" .BCC = "" .Subject = strSubject .HTMLBody = Uebersetzung(strQuelle) '.Send .Display End With Set OutMail = Nothing Set OutApp = Nothing End Sub Public Function Uebersetzung(strQuelle As String) Dim objFSO As Object Dim objInhalt As Object Dim strTempDatei As String strTempDatei = strTempOrdner & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" With ActiveWorkbook.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=strTempDatei, _ Sheet:=ActiveSheet.Name, _ Source:=strQuelle, _ HtmlType:=xlHtmlStatic) .Publish (True) End With Set objFSO = CreateObject("Scripting.FileSystemObject") Set objInhalt = objFSO.GetFile(strTempDatei).OpenAsTextStream(1, -2) Uebersetzung = objInhalt.ReadAll objInhalt.Close Set objInhalt = Nothing Set objFSO = Nothing Kill strTempDatei End Function

Bei neueren Outlookversionen kann es zu einer Fehlermeldung kommen:

Ein Programm versucht, Nachrichten mit Item.Send zu senden. Ein Programm versucht, mit dem Befehl Item.Send der Anwendung Microsoft Outlook Visual Basic automatisch E-Mail-Nachrichten zu senden. Wenn Sie möchten, dass das Programm diese E-Mail-Nachricht sendet, klicken Sie auf Ja. Klicken Sie auf Nein, um das Programm zu beenden. Wenn Sie sich nicht sicher sind, welches Programm die E-Mail-Nachricht sendet oder warum, sollten Sie auf Nein klicken, um ein mögliches Verbreiten von Viren zu vermeiden.

Bei Anzeige dieser Meldung steht die Schaltfläche Ja 5 Sekunden lang nicht zur Verfügung.

Vielleicht ist dieser Tipp besser geeignet: Mails mit VBA und PHP versenden (mehrere Empfänger, mehrere Anhänge).

Blatt einfügenMakro/Sub/Prozedur

Kategorie: Mappe ▸ Tabellen

(Tipp 110) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich ein neues Blatt einfügen? Dabei soll überprüft werden, ob ein Blatt mit dem Namen schon existiert und der linke und rechte Seitenrand auf einen Zentimeter festgelegt werden.

In eine Inputbox kann der Name des zu erzeugenden Blattes eingetragen werden. Anschließend wird mit einer Schleife geprüft, ob der Name schon vergeben ist. Wenn nicht, wird das Blatt eingefügt und die Seitenränder werden festgelegt.

Sub Blatterstellen() Dim wksBlatt As Object Dim strNeu As String strNeu = InputBox("Bitte Namen des neuen Arbeitsblattes eingeben:") For Each wksBlatt In ActiveWorkbook.Sheets If wksBlatt.Name = strNeu Then MsgBox "Blattname existiert bereits!", vbOKOnly + vbExclamation, "Blatt hinzufügen" Exit Sub End If Next Sheets.Add ActiveSheet.Name = strNeu With Sheets(strNeu).PageSetup .LeftMargin = Application.CentimetersToPoints(1) .RightMargin = Application.CentimetersToPoints(1) End With End Sub

Eine andere Möglichkeit, bei der auch gleich festgelegt wird, wo das Blatt eingefügt werden soll:

Sub Blatterstellen1() Dim wksBlatt As Object Dim strNeu As String strNeu = InputBox("Bitte Namen des neuen Arbeitsblattes eingeben:") For Each wksBlatt In ActiveWorkbook.Sheets If wksBlatt.Name = strNeu Then MsgBox "Blattname existiert bereits!", vbOKOnly + vbExclamation, "Blatt hinzufügen" Exit Sub End If Next Set wksBlatt = Sheets.Add(before:=Sheets(1)) wksBlatt.Name = strNeu With wksBlatt.PageSetup .LeftMargin = Application.CentimetersToPoints(1) .RightMargin = Application.CentimetersToPoints(1) End With End Sub

Blattnamen durch Klick auf Kombinationsfeld einfügenMakro/Sub/ProzedurTipp

Kategorien: Steuerelemente ▸ ActiveX und Mappe ▸ Tabellen

(Tipp 152) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich auf einem Blatt ein Kombinationsfeld erstellen, in dem die Namen der Blätter enthalten sind? Durch Klick in das Kombinationsfeld soll der angeklickte Name in A1 erscheinen.

  • Menüband Entwicklertools einblenden (Rechtsklick in leere Stelle des Menübands und Menüband anpassen)
  • Einfügen ▸ ActiveX-Steuerelemente ▸ Kombinationsfeld
  • Kombinationsfeld zeichnen
  • Doppelklick auf das Feld, dadurch wird der VBA-Editor geöffnet
  • folgenden Code eingeben (Zelle anpassen):

Private Sub ComboBox1_Change() Range("A1") = ComboBox1.Text End Sub[/vbacode]

  • Menü Einfügen - Modul
  • folgendes Makro eingeben (dient zum Füllen des Kombinationsfeldes):

Sub Fuellen() Dim intI As Integer Sheets("Tabelle1").ComboBox1.Clear For intI = 1 To Sheets.Count Sheets("Tabelle1").ComboBox1.AddItem (Sheets(intI).Name) Next End Sub

Durch den Aufruf des Makros Fuellen wird das Kombinationsfeld gefüllt; nach der Auswahl eines Blattes erscheint dessen Name im Beispiel in A1.

ChartereignisseMakro/Sub/ProzedurTipp

Kategorien: Basics ▸ Ereignisse und Ereignisse ▸ Basics

(Tipp 101) Nachricht zum Beitrag an Autor Nach oben

Um Chartereignisse nutzen zu können, muss man vorher ein Klassenmodul erstellen. Dieses ist im Gegensatz zu den Application-Ereignissen jedoch recht einfach zu bewerkstelligen.

Anlegen des Klassenmoduls:

Gehen Sie im Visual-Basic-Editor auf Einfügen ▸ Klassenmodul und geben folgendes ein:

Public WithEvents Diagramm As Chart

Um alles übersichtlicher zu gestalten, sollte man der Klasse den Namen Diagrammklasse geben (unter Eigenschaften/Namen). Nun stehen in der linken Drop-Down-Liste die neue Klasse und in der rechten die dazugehörigen Eigenschaften zur Verfügung. Damit die Ereignisprozeduren ausgeführt werden, muss man nun das Diagramm der Diagrammklasse zuordnen. Dies geschieht in einem beliebigen Modul durch folgenden Code:

Dim MeinDiagramm As New Diagrammklasse Sub DiagrammZuordnen() Set MeinDiagramm.Diagramm = Worksheets(1).ChartObjects(1).Chart End Sub

Parameter:

Wie man erkennen kann, übergeben auch die Chartereignisse Parameter. Da man nun allerdings eine Klasse definiert hat, sind diese derart vielfältig, dass sie hier nicht aufgeführt werden. Sie sind aber in der Online-Hilfe ausreichend erklärt.

Chartereignisse:

Diagramm_Activate
Tritt ein, wenn das Diagramm aktiviert wird. War das Diagramm vor einem Blattwechsel aktiv und wird wieder zu diesem Blatt gewechselt, tritt dieses Ereignis auch ein.
Diagramm_BeforeDoubleClick(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long, Cancel As Boolean)
Tritt bei einem Doppelklick auf.
Diagramm_BeforeRightClick(Cancel As Boolean)
Tritt beim drücken der rechten Maustaste ein.
Diagramm_Calculate
Tritt auf, wenn das Diagramm neu gezeichnet wird, z. B. neue Daten.
Diagramm_Deactivate
Tritt bei einem Blatt- oder Diagrammwechsel auf.
Diagramm_DragOver
Tritt ein, wenn ein Zellbereich über ein Diagramm gezogen wird, aber noch nicht losgelassen ist.
Diagramm_DragPlot
Tritt ein, wenn ein Zellbereich über ein Diagramm gezogen wurde und losgelassen wurde.
Diagramm_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Tritt ein, wenn die Maustaste gedrückt wird.
Diagramm_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Tritt ein, wenn die Maus bewegt wird.
Diagramm_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Tritt ein, wenn die Maustaste losgelassen wurde.
Diagramm_Resize
Tritt ein, wenn die Diagrammgröße verändert wurde.
Diagramm_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
Tritt ein, wenn das Diagramm ausgewählt wurde.
Diagramm_SeriesChange(ByVal SeriesIndex As Long, ByVal PointIndex As Long)
Tritt bei einer Veränderung der ausgewählten Datenreihe ein.

Computernamen auslesenMakro/Sub/ProzedurUDF - benutzerdefinierte FunktionTipp

Kategorie: System ▸ Windows

(Tipp 569) Nachricht zum Beitrag an Autor Nach oben

Wie kann man den Namen des Computers, also des Systems, auf dem die Anwendung läuft, auslesen?

Die verschiedenen Deklarationen sind wichtig, um das Funktionieren sowohl in der 64-Bit-Version des Microsoft Office (also nicht von Windows) als auch in der 32-Bit-Version zu gewährleisten.

#If VBA7 Then Private Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As LongPtr) As LongPtr #Else Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long #End If Sub ComputerName() Dim lngTemp As LongPtr, strPCName As String strPCName = Space(256) lngTemp = GetComputerName(strPCName, Len(strPCName)) MsgBox strPCName End Sub

Das kann man natürlich auch als UDF erstellen:

Function ComputerName1() Dim lngTemp As LongPtr, strPCName As String strPCName = Space(256) lngTemp = GetComputerName(strPCName, Len(strPCName)) ComputerName1 = strPCName End Function

In die Zelle wird einfach =computername1() eingetragen.

Datei mit fortlaufender Nummer speichernMakro/Sub/Prozedur

Kategorien: Dateien und Ordner ▸ Dateioperation und Dateien und Ordner ▸ Dokumenteigenschaften

(Tipp 19) Nachricht zum Beitrag an Autor Nach oben

Wie kann man in einer Datei eine fortlaufende Nummer speichern?

In einer Zelle

Die Nummer in eine Zelle schreiben, die auch ausgeblendet werden kann. Dann bei jedem Speichern die Nummer mit z. B. Range("A1") = Range("A1") + 1 erhöhen.


In den Dokumenteigenschaften

Die CustomDocumentProperties der Datei können auch mit VBA-Code verwendet werden. Dann wird die Nummer versteckt in dieser Datei gespeichert:

Dazu einmalig die Eigenschaft mit der folgenden Zeile erstellen:

ThisWorkbook.CustomDocumentProperties.Add Name:="lfdNr", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=0

Anzeigen kann man den Wert, der neu 0 ist, mit der Zeile:

MsgBox ThisWorkbook.CustomDocumentProperties("lfdNr").Value

Erhöht wird der der Wert mit

ThisWorkbook.CustomDocumentProperties("lfdNr").Value = ThisWorkbook.CustomDocumentProperties("lfdNr").Value + 1

Nach dem Erhöhen des Wertes nicht vergessen, die Datei zu speichern. Auch wenn diese Eigenschaften nicht sichtbar sind, sind sie doch in der Datei enthalten.


Separate Textdatei

Oder die Nummer in eine Datei auslagern, zum Beispiel so:

Sub lfdNr() Dim lngDNr As Long, intNr As Integer Dim strDName As String, strZielordner As String, strDateiname As String strZielordner = ThisWorkbook.Path & "\" 'Hier den Pfad verändern strDateiname = "Excel_lfdNr" 'Hier den Dateinamen verändern strDName = strZielordner & strDateiname & ".ini" intNr = 0 lngDNr = FreeFile If Dir(strDName) <> "" Then Open strDName For Input As #lngDNr Input #lngDNr, intNr Close #lngDNr End If intNr = intNr + 1 lngDNr = FreeFile Open strDName For Output As #lngDNr Print #lngDNr, intNr; Close #lngDNr ActiveCell.Value = intNr End Sub

Dateien nach Datum auflistenMakro/Sub/Prozedur

Kategorien: Dateien und Ordner ▸ Dateien und Dateien und Ordner ▸ Dateieigenschaften

(Tipp 22) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich in einem Tabellenblatt alle Dateien auflisten, deren letztes Änderungsdatum nach einem anzugebenden Datum liegt?

Der Code listet auf dem aktiven Tabellenblatt alle Dateien auf, deren Datumsangaben nach dem Datum liegen, das in eine InputBox eingegeben wurde.

Alle Dateien auflisten:

Sub DateiListe() Dim strOrdner As String, strFName As String, intI As Integer, varDatum Application.ScreenUpdating = False varDatum = InputBox("Ab wann?") If Not IsDate(varDatum) Then Exit Sub On Error GoTo ErrorHandler varDatum = CDate(varDatum) strOrdner = "C:\Ordnerpfad\" strFName = Dir(strOrdner & "*.xlsm") 'Ordner anpassen! intI = 0 Do While strFName <> "" If FileDateTime(strOrdner & strFName) > varDatum Then intI = intI + 1 Worksheets(1).Cells(intI, 1) = strFName Worksheets(1).Cells(intI, 2) = Format(FileDateTime(strOrdner & strFName), "DD.MM.YY") End If strFName = Dir() Loop ErrorHandler: Application.ScreenUpdating = True End Sub

Der Ordner muss natürlich noch angepasst werden und ggf. ist eine Prüfung, ob tatsächlich ein gültiges Datum eingegeben wurde, sinnvoll.

Vorsicht auch, falls sich auf dem Tabellenblatt bereits Daten befinden - die werden gnadenlos überschrieben. Möglich ist, für die Liste ein neues Tabellenblatt erstellen zu lassen.



Eigene Menüleiste mit Untermenüs erstellenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 40) Nachricht zum Beitrag an Autor Nach oben

Wie kann man eine eigene Menüleiste mit Untermenüs erstellen und diese anstelle der Tabellenblattmenüleiste anzeigen lassen?

Nostalgie - mehr ist das wohl heute nicht mehr. Oder nutzt noch jemand die alten Menüs in Excel?

Sub MenueErstellen() Dim objAktiveMenueLeiste As Object Dim objMeinMenue As Object, objBefehl As Object, objMB As Object 'objMB, objMeinMenue, Befehl und objAktiveMenüLeiste sind Variablen On Error Resume Next 'Eigene Menüleiste löschen, falls Makro nochmal aufgerufen wird: Application.CommandBars("MeinMenü").Delete 'Falls keine eigene Menüleiste erstellt wurde, sondern nur ein Menü: CommandBars.ActiveMenuBar.Controls("Mein Menü").Delete 'Menüleiste hinzufügen und einblenden 'Soll die aktive Menüleiste ersetzt werden, Hochkommas entfernen: 'Set objMB = CommandBars.Add(Name:="MeinMenü", MenuBar:=True) 'CommandBars("MeinMenü").Visible = True Set objAktiveMenueLeiste = CommandBars.ActiveMenuBar 'Menü erstellen Set objMeinMenue = objAktiveMenueLeiste.Controls.Add(Type:=msoControlPopup, Temporary:=True) objMeinMenue.Caption = "&Mein Menü" 'Anstelle Makroname den Makro einsetzen 'Erster Befehl im Menü Set objBefehl = objMeinMenue.Controls.Add(Type:=msoControlButton, ID:=1) With objBefehl .Caption = "&1. Befehl" .OnAction = "Makroname" End With 'Zweiter Befehl im Menü Set objBefehl = objMeinMenue.Controls.Add(Type:=msoControlButton, ID:=1) With objBefehl .Caption = "&2. Befehl" .OnAction = "Makroname" End With End Sub 'Um die Original-Menüleiste wieder einzublenden kann man 'folgendes Makro verwenden: Sub EigeneMenueLeisteLoeschen() On Error Resume Next 'Löscht die selbsterstellte Menüleiste: Application.CommandBars("MeinMenü").Delete 'Löscht nur das Menü CommandBars.ActiveMenuBar.Controls("Mein Menü").Delete End Sub

EreignisprozedurenTipp

Kategorien: Basics ▸ Ereignisse und Ereignisse ▸ Basics

(Tipp 96) Nachricht zum Beitrag an Autor Nach oben

Ereignisprozeduren sind Makros, die als Reaktion auf bestimmte Ereignisse ausgeführt werden. Der Begriff „Ereignis“ kann weit gedehnt werden, primär sind allerdings gerade die Ereignisse von Interesse, die beim Arbeiten mit Steuerelementen, Tabellen und Arbeitsmappen eintreten können.

Mit Excel97 erhielten Ereignisprozeduren ein völlig neues System. Während man unter Excel 5/7 noch über die On-Event-Eigenschaft oder über die Methoden der Objekte Prozeduren zuwies, sind diese seit Excel97 in der Entwicklungsumgebung fester Bestandteil der Objekte. Dies erleichtert erstens den Überblick über die Ereignisprozeduren und zweitens müssen die Zuordnungen zwischen Prozedur und Ereignis nicht immer neu hergestellt werden, da diese nun fest an das jeweilige Objekt gebunden sind. Auch kann man nun durch die einfache Übergabe von Parametern, die Caller-Eigenschaft, die man unter Excel 5/7 immer wieder einsetzen musste, verzichten.

Die erste Frage, die auftaucht, ist: Wo finde ich diese Ereignisprozeduren überhaupt?

Es wird zwischen 5 Objektereignissen unterschieden:

  1. Application-Ereignisse (siehe Beschreibung)
  2. Workbook-Ereignisse (im Projektfenster auf Diese Arbeitsmappe doppelklicken)
  3. Worksheet-Ereignisse (im Projektfenster auf die jeweilige Tabelle doppelklicken)
  4. On-Event-Ereignisse des Application-Objekts (wird im Code selbst deklariert)
  5. Chart-Ereignisse (zur Verwendung von Chartereignissen muß man ein Klassenmodul erstellen)

Excel-Kommunikator: Mails versenden und Chat mit Excel

Kategorie: Add-In ▸ Kommunikation

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

Wie kann ich aus Excel heraus schnell Informationen und Daten mit anderen Excel-Usern austauschen?

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.


Mit diesem Chat- und Mail-Add-In ist es möglich, Gespräche zu führen, Bereiche aus Exceltabellen auszutauschen und Mails mit Anhängen zu senden. Es ist also ein schneller Informationsaustausch gewährleistet, ohne zu einem anderen Programm wechseln zu müssen. Der Austausch erfolgt dabei überwiegend im Menüband in eigenen Ribbon-Tabs. Bei den Informationen kann es sich um einfache Postings handeln, um Inhalte von Zellen oder Bereichen (Werte oder Formeln) oder um Mails mit Anhängen. So ist es zum Beispiel möglich, die aktuelle Mappe per Mausklick an mehrere Empfänger zu senden oder Tabellenbereiche an andere Nutzer zu übermitteln.

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.


Nach oben Chat

Eigener Nickname

Mit diesem sind Sie überall sichtbar. Eintragen, Frage nach Registrierung mit »Ja« beantworten, fertig. Pro Add-In wird ein Name vergeben; Sie können also die Add-In-Datei auch an einem anderen Arbeitsplatz verwenden.

Gruppen

Sie haben die Möglichkeit, sich in verschiedenen Gruppen zu unterhalten. Die Gruppe »offen« ist voreingetragen, hier kann jeder ohne Kennwort lesen und schreiben.

Möchten Sie eine Gruppe hinzufügen, klicken Sie auf »Gruppe hinzufügen« und tragen Sie anschließend im Dialog den gewünschten Gruppennamen ein. Hier gibt es zwei Möglichkeiten:

Existiert der Gruppenname bereits, können Sie das Kennwort eintragen und so der Gruppe beitreten.
Existiert der Gruppenname noch nicht, können Sie ein Kennwort vergeben und so Ihre eigene Gruppe erstellen. Den Namen und das Kennwort können Sie dann ausgewählten Personen geben, damit diese auf diesem Weg dieser Gruppe beitreten können. So können Sie sich mit einem begrenzten Personenkreis unterhalten, zum Beispiel einer Mitarbeitergruppe.

Im Gruppe-Auswahlfeld wählen Sie ganz einfach, welche Postings Sie lesen und wo Sie schreiben möchten.

Posten und Listenanzeige

Ihren Text geben Sie nach der Wahl der gewünschten Gruppe einfach in »Ihre Msg« ein und senden ihn mit »Enter« ab. In der Liste »Msgs« sehen Sie die aktuellen Beiträge chronologisch rückwärts, also den aktuellsten Beitrag ganz oben.

Zellen und Bereiche posten

Sie können nicht nur eigene Postings schreiben, sondern auch Inhalte aus der Tabelle posten.

Was dabei übermittelt wird, hängt vom Kästchen »Formel« ab - ist es deaktiviert, werden die Werte der Zellen übermittelt (im Beispiel „-06:30“), sonst die Formeln, falls welche eingetragen sind (sonst auch die Werte).

Klicken Sie auf »Zelle posten«, wenn Sie den Inhalt der gerade aktiven Zelle posten möchten. Dieser erscheint dann wie gehabt in der Liste der Postings.

Markieren Sie einen Bereich und wählen Sie »Bereich posten«, wenn Sie einen kompletten Tabellenbereich übermitteln möchten. In diesem Fall erscheint in den Postings nicht der Inhalt des Bereiches, sondern der Hinweis, dass es sich um einen Tabellenbereich handelt und um welchen Bereich. Dies ist wichtig, um diesen Inhalt später wieder an der richtigen Stelle einfügen zu können.

Ausgaben

Postings können auch in Tabellen übernommen werden. Wichtig ist dafür, dass das gewünschte Posting in der Liste gewählt und der Zielbereich ab der aktiven Zelle frei ist - bereits vorhandene Zellinhalte werden sonst überschrieben.

Mit »Posting in Zelle« wird das gewählte Posting in die aktive Zelle eingetragen, wie es in der Liste zu sehen ist. Ausnahme ist dabei ein Tabellenbereich - handelt es sich beim gewählten Posting um einen solchen, wird der Bereich entsprechend des Quellbereiches ab der aktiven Zelle eingetragen. Sind Formeln enthalten, ist es sinnvoll, dass die aktive Zelle die ist, die im Beginn des Tabellenbereiches angegeben ist, damit die Bezüge in den Formeln stimmen. Im Beispiel aus dem Screenshot sollte also die aktive Zelle E1 sein, wenn das Posting mit dem Bereich eingefügt wird.

Formatierungen werden nicht übernommen, eingetragene Bereiche müssen also ggf. nachformatiert werden. Dies betrifft insbesondere Datums- und Zeitformate.

Mit »Postingliste in Tabelle« werden die Postings der gewählten Gruppe einfach in eine neu erstellte Tabelle eingetragen.

Neue Nachrichten

Aus Performancegründen werden neue Postings von anderen Nutzern nicht sofort angezeigt.

Die Aktualisierung der Beiträge in einer Gruppe erfolgt über den Button »Refresh«.

Sollen die Beiträge einer Gruppe automatisch aktualisiert werden, aktivieren Sie »Autofrefresh [an|aus]«. Damit werden die Beiträge alle 15 Sekunden abgerufen und in der Liste aktualisiert. Im Falle eines neuen Postings wird der Chat-Tab automatisch aktiviert und es erscheint ein Hinweissymbol »Neues Posting!«.
Haben Sie »Sprachnachricht« aktiviert, wird das neue Posting vorgelesen.


Nach oben Mail

Voraussetzung für die Nutzung ist, dass in »Chat« der Nickname registriert wurde.

Absender

Die Absenderangaben werden einfach eingetragen und bleiben bis zur nächsten Änderung gespeichert. Da das Add-In keine Mails empfangen kann, sollte die Absenderadresse eine solche sein, an die der Empfänger antworten kann.

Empfänger

Zur Eingabe der Empfänger gibt es mehrere Möglichkeiten.

Die Mailadressen können direkt in das Eingabefeld eingetragen werden, mehrere durch Semikolon getrennt.

Im Bereich »Zusammenstellen« kann zwischen Add-In- und Outlookkontakten umgeschaltet werden. Im Anschluss wird der entsprechende Eintrag gewählt und mit »Zu Empfängern hinzufügen« in das Feld für die Empfänger übernommen.

Die Liste der Add-In-Kontakte wird über den kleinen Dialoglauncher unten rechts zur Bearbeitung aufgerufen.

Mailtext, Anhang

Mailtext und Anhang beim Versand einer externen Datei werden in den jeweiligen Dialogen eingegeben bzw. gewählt, die nach Klick auf »Mailtext« bzw. »Datei« erscheinen. Wichtig beim Versand des aktiven Blattes ist, dass das Add-In dort gespeichert ist, wohin das Add-In eine temporäre Datei speichern kann.

Die Dateigröße des Anhangs ist derzeit auf 500 KB begrenzt.

Versand

Mit Klick auf die entsprechende Schaltfläche erfolgt der Versand, bei Erfolg erscheint eine Meldung. Bei größeren Dateien kann dies natürlich auch einen Moment dauern.


Nach oben Backup und Restore

Backup

Natürlich kann der Fall eintreten, dass das Add-In einmal neu installiert werden muss - sei es wegen eines Updates oder wegen eines Datenverlusts. Handelt es sich dann um eine neue Add-In-Datei, wäre der Nick nicht mehr zugänglich, weil ja u. a. die Daten dazu weg wären.

Für diesen Fall (und beabsichtigte Erweiterungen) ist es möglich, ein Backup auf dem Server zu erstellen. Dazu dient der Button »Sicherung«, der dann sichtbar ist, wenn ein Nick eingerichtet wurde. Damit werden alle Einstellungen des Add-Ins gesichert.

Beim ersten Erstellen eines Backups erhalten Sie ein Kennwort, das unbedingt aufbewahrt werden muss. Ansonsten können Sie nach Belieben Backups erstellen - einfach auf den Button klicken und bestätigen.

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.


Nach oben 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.


Nach oben 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

In einer Schleife auf Elemente einer UserForm zugreifenMakro/Sub/Prozedur

Kategorie: Steuerelemente ▸ Userform

(Tipp 90) Nachricht zum Beitrag an Autor Nach oben

Wie kann man auf einzelne, vorher durch VBA-Code erzeugte Label zugreifen und deren Caption neu festlegen?

Es wird eine Collection erstellt, die die Labels enthält. Darauf kann dann zugegriffen werden. Sollen jedoch andere Routinen (Subs, Functions) des Moduls auch Zugriff haben, muss die Deklaration Dim colLabels As New Collection an den Anfang des Moduls.

Private Sub UserForm_Initialize() Dim bytN As Byte, ctrLabel As Control, colLabels As New Collection For bytN = 1 To 3 Set ctrLabel = Controls.Add("Forms.label.1") ctrLabel.Top = bytN * 20 ctrLabel.Left = 20 ctrLabel.Caption = ctrLabel.Name colLabels.Add ctrLabel Next For bytN = 1 To 3 colLabels(bytN).Caption = "Test " & bytN Next End Sub

Integrierte Dialogfelder aufrufenMakro/Sub/Prozedur

Kategorie: Interaktion ▸ Dialoge

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

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

Application.Dialogs(Konstante).Show

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

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

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

Download: integrierte_dialogfelder.xlsm

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

Kategorien: Netz ▸ Serverkommunikation und Stringoperationen ▸ JSON

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

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

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

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

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

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

Eine Ebene

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

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

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

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

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

Nun können wir das Ganze losschicken:

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

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

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

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

Hier der gesamte Code zum Testen:

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

 

Verschachtelungen, mehrere Ebenen

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

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

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

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

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

Oder etwas komprimierter, indem wir den Array analysieren:

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

Der gesamte Code zum Testen:

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

Download: excel_php_json.xlsm

Mails mit VBA und PHP versenden (mehrere Empfänger, mehrere Anhänge)Makro/Sub/ProzedurTipp

Kategorien: Netz ▸ Serverkommunikation und Netz ▸ Mail

(Tipp 600) Nachricht zum Beitrag an Autor Nach oben

Wie können mit VBA Mails mit mehreren Dateianhängen an mehrere Empfänger gesendet werden?

Die Aufgabenstellung, per Mausklick oder automatisiert Mails zu versenden, ist sehr weit verbreitet. Es gibt auch viele Tipps, wie das mit Outlook erfolgen kann. Jedoch gibt es immer wieder Probleme, sei es durch Rechtebeschränkungen, wegzuklickende Meldungen von Outlook usw.

Am sinnvollsten ist deshalb eine Lösung, mit der man weitestgehend unabhängig von Officeprogrammen ist. Hier besteht die Möglichkeit, VBA nur zum Versand der Maildaten an einen Server zu benötigen, der dann den Rest des Erstellens und Versands der Mail übernimmt.

Voraussetzung für dieses Beispiel ist, dass auf dem Server ein eigenes PHP-Script erstellt werden kann, das dann natürlich auch eine Adresse (URL) hat.

Basis ist der Beitrag Dateiupload. Der VBA-Code dazu wurde hier um die Möglichkeit, Text zu versenden, erweitert. Prinzipiell trifft hier aber das Gleiche zu - vor allem, dass die oben verwendeten Konstanten auch dynamisch verwendet werden können. Hier wird nur das Prinzip aufgezeigt, die Anpassungen müssen dann entsprechend der eigenen Gegebenheiten erfolgen. Dies betrifft insbesondere auch die Sicherheit. Denken Sie daran, die manuell zu ändernden Daten vorher zu prüfen. Diese Scripte sind auch leicht zum Versand von Massenspam zu verwenden.

Dies ist der VBA-Code, der um die Text-Funktion erweitert wurde:

Private Const strURL As String = "https://…Ihre URL…/…Ihre PHP-Datei….php" Private Const strDatei1 As String = "C:\…\test1.jpg" Private Const strDatei2 As String = "C:\…\test2.jpg" Private Const strDatei3 As String = "C:\…\test3.jpg" Private Const strMailEmpfaenger As String = "info1@example.org;info2@example.org;info3@example.org" Private Const strAbsText As String = "Max Mütze" Private Const strAbsMail As String = "xyz@example.org" Private Const strBoundary As String = "---------------------------7da24f2e50046" Sub DateiUploadUndMail() Dim strPostDaten As String strPostDaten = "" strPostDaten = strPostDaten & Header_Text("empfaenger", strMailEmpfaenger, "text/plain", strBoundary) strPostDaten = strPostDaten & Header_Text("abstext", strAbsText, "text/plain", strBoundary) strPostDaten = strPostDaten & Header_Text("absmail", strAbsMail, "text/plain", strBoundary) strPostDaten = strPostDaten & Header_Text("betreff", "Das ist der Betreff.", "text/plain", strBoundary) strPostDaten = strPostDaten & Header_Text("mailtext", "Hallo!" & vbNewLine & vbNewLine & "Ich bin der Mailtext.", "text/html", strBoundary) strPostDaten = strPostDaten & Header_Datei(strDatei1, strBoundary) strPostDaten = strPostDaten & Header_Datei(strDatei2, strBoundary) strPostDaten = strPostDaten & Header_Datei(strDatei3, strBoundary) strPostDaten = strPostDaten & "--" & strBoundary & "--" With CreateObject("Microsoft.XMLHTTP") .Open "POST", strURL, False .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary .Send SendDaten(strPostDaten) MsgBox .ResponseText End With End Sub Function Header_Text(strKey As String, strValue As String, strMime As String, strBoundary) Header_Text = "--" & strBoundary & vbCrLf & _ "Content-Disposition: form-data; name=""" & strKey & """;" & vbCrLf & _ "Content-Type: " & strMime & "; charset=UTF-8" & vbCrLf & vbCrLf & strValue & vbCrLf End Function Function Header_Datei(strDateiPfad As String, strBoundary As String) Dim strDateiKonv As String, strDateiName As String Header_Datei = "" If strDateiPfad <> "" Then strDateiName = DateiName(strDateiPfad) strDateiKonv = DateiKonv(strDateiPfad) Header_Datei = "--" & strBoundary & vbCrLf & _ "Content-Disposition: form-data; name=""file[]""; filename=""" & strDateiName & """" & vbCrLf & _ "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & strDateiKonv & vbCrLf End If End Function Function DateiName(strpfad As String) DateiName = "" If strpfad <> "" Then DateiName = Mid$(strpfad, InStrRev(strpfad, "\") + 1) End Function Function DateiKonv(strpfad As String) Dim lngDNr As LongPtr, bytBuffer() As Byte DateiKonv = "" lngDNr = FreeFile Open strpfad For Binary Access Read As lngDNr If LOF(lngDNr) > 0 Then ReDim bytBuffer(0 To LOF(lngDNr) - 1) As Byte Get lngDNr, , bytBuffer DateiKonv = StrConv(bytBuffer, vbUnicode) End If Close lngDNr End Function Private Function SendDaten(strText As String) As Byte() SendDaten = StrConv(strText, vbFromUnicode) End Function

Damit werden die Daten an das PHP-Script gesendet, das diese empfängt und daraus die Mails erstellt sowie diese versendet. Auch hier unbedingt daran denken, die Daten noch auf Gültigkeit zu prüfen!

Das komplette PHP-Script:

/* Wichtig: Da das Script prinzipiell auch zu Versand von Massenspam geeignet ist, sollten ganz am Anfang noch Kennwort und Nutzername (oder eine andere Absicherung) abgefragt werden. Diese Angaben können von VBA aus ganz einfach als POST-Paare mitgeschickt werden. */ // Verzeichnis, in dem die Anhänge zwischengespeichert werden: $anhangverz = 'uploadtest/'; // Vorsicht: Ggf. prüfen, ob vorhanden und leer. // Mailadressen durch Semikolon getrennt $empfstrings = $_POST['empfaenger']; // Text, der als Absender erscheint: $abstext = $_POST['abstext']; // Mailadresse des Absenders: $absmail = $_POST['absmail']; $betreff = utf8_encode($_POST['betreff']); $mailtext = utf8_encode($_POST['mailtext']); // File[]-Array sinnvoll sortieren: $dateiarray = array(); foreach($_FILES['file'] as $k1 => $v1) { foreach($v1 as $k2 => $v2) { $dateiarray[$k2][$k1] = $v2; } } // Anhänge speichern, Daten für Versand aufbereiten $anhangarray = array(); $a = 0; foreach ($dateiarray as $file) { // Ggf. prüfen, ob Dateiname schon im Verzeichnis vorhanden ist und // ggf. umbenennen: $datname = basename($file['name']); $uploadpfad = $anhangverz . $datname; if (move_uploaded_file($file['tmp_name'], $uploadpfad)) { $a++; $anhangarray[$a]['pfad'] = $uploadpfad; $anhangarray[$a]['dateiname'] = $datname; $anhangarray[$a]['groesse'] = filesize($uploadpfad); $dateiinhalt = fread(fopen($uploadpfad, "r"), filesize($uploadpfad)); $anhangarray[$a]['data'] = chunk_split(base64_encode($dateiinhalt)); } } $empf_array = explode(";",$empfstrings); $encoding = mb_detect_encoding($mailtext, "utf-8, iso-8859-1, cp-1252"); $mime_boundary = "-----=" . md5(uniqid(microtime(), true)); $versendet = 0; // Mail an jeden Empfänger schicken: foreach($empf_array as $einzelmail) { if (trim($einzelmail) != "") { $header ="From:" . $abstext . "<" . $absmail . ">\n"; $header.= "MIME-Version: 1.0\r\n"; $header.= "Content-Type: multipart/mixed;\r\n"; $header.= " boundary=\"" . $mime_boundary . "\"\r\n"; $content = "This is a multi-part message in MIME format.\r\n\r\n"; $content.= "--".$mime_boundary."\r\n"; $content.= "Content-Type: text/plain; charset=\"$encoding\"\r\n"; $content.= "Content-Transfer-Encoding: 8bit\r\n\r\n"; $content.= $mailtext . "\r\n"; if ($a > 0) { // Ggf. Mailanhänge anfügen for ( $n = 1; $n <= $a; $n++) { $content.= "--" . $mime_boundary . "\r\n"; $content.= "Content-Disposition: attachment;\r\n"; $content.= "\tfilename=\"" . $anhangarray[$n]['dateiname'] . "\";\r\n"; $content.= "Content-Length: " . $anhangarray[$n]['groesse'] . ";\r\n"; $content.= "Content-Type: application/pdf; name=\"" . $anhangarray[$n]['dateiname'] . "\"\r\n"; $content.= "Content-Transfer-Encoding: base64\r\n\r\n"; $content.= $anhangarray[$n]['data'] . "\r\n"; } } $content .= "--" . $mime_boundary . "--"; if (mail($einzelmail, $betreff, $content, $header)) { $versendet++; } } } // Ggf. Mailanhänge löschen if ($a > 0) { for ( $n = 1; $n <= $a; $n++) { if ($anhangarray[$n]['pfad'] != "") {unlink($anhangarray[$n]['pfad']);} } } // Meldung, die in VBA in der MsgBox als .ResponseText erscheint: echo $versendet . " Mail(s) erfolgreich gesendet.";



Makros immer zur Verfügung stellenTipp

Kategorie: Basics ▸ VBA

(Tipp 102) Nachricht zum Beitrag an Autor Nach oben

Wie kann man erreichen, daß die Makros immer zur Verfügung stehen, egal, welche Mappe gerade offen ist?

Makros werden in der Regel in der Mappe gespeichert, in der sie benötigt werden. Aber es gibt auch Makros, die immer zur Verfügung stehen sollen, die also sofort beim Aufruf von Excel bereit sein sollen.

Häufig liest man hierzu die Empfehlung, man solle die Makros in der sogenannten Persönlichen Makroarbeitsmappe speichern. Diese Methode hat jedoch gravierende Nachteile. Besser ist es, wenn man sich Add-Ins erstellt und diese über den Add-Ins-Manager einblendet.

Erstellen eines Add-Ins

  1. Zuerst erstellt man ganz normal seine Makros/VBA-Routinen, indem man sie aufzeichnet oder selbst schreibt (siehe hierzu auch Wo gibt man nun die Makros ein?).
  2. Anschließend wählt man in Excel in der Mappe, in der sich die Makros befinden, den Befehl Datei - Speichern unter und gibt einen aussagekräftigen Dateinamen ein.
  3. Dann wählt man im Dialogfeld ganz unten den Dateityp Microsoft Excel-Add-In (*.xlam). Daraufhin wechselt Excel automatisch in den Pfad, in dem sich standardmäßig die Add-Ins befinden - man kann den Ordner auch wechseln. Hauptsache ist natürlich, dass man später weiß, wohin man gespeichert hat.
  4. Mit einem Klick auf Speichern steht das Add-In sofort zur Verfügung. Excel speichert es und ergänzt den Namen mit der Endung .xlam.

Nun ist das Add-In gespeichert und steht zur Verfügung, arbeiten kann man damit aber noch nicht. Um das Add-In zu aktivieren, geht man wie folgt vor:

Einbinden des Add-Ins

Aktuell
  1. Datei ▸ Optionen
  2. Add-Ins
  3. Verwalten: Excel-Add-Ins ▸ Los
  4. Durchsuchen
  5. Add-In-Datei suchen
  6. OK
  7. Prüfen, dass das Add-In in der Liste enthalten und das Häkchen gesetzt ist
  8. OK
Ab Excel 2007
  1. Office-Schaltfläche (oben links)
  2. Excel-Optionen
  3. Add-Ins
  4. Verwalten: Add-Ins > Gehe zu ...
  5. Durchsuchen
  6. Add-In-Datei suchen
  7. OK
  8. Prüfen, dass das Add-In in der Liste enthalten und das Häkchen gesetzt ist
  9. OK
Frühere Excel-Versionen
  1. Extras
  2. Add-Ins-Manager
  3. Durchsuchen
  4. Add-In-Datei suchen
  5. OK
  6. Prüfen, dass das Add-In in der Liste enthalten und das Häkchen gesetzt ist
  7. OK

Fertig - nun stehen alle Makros dieses Add-Ins immer zur Verfügung, auch, wenn man Excel beendet und neu startet.

Nachträgliches Bearbeiten der Makros

Möchte man die Makros nachträglich ändern oder ergänzen, ist dies auch kein Problem. Man wechselt mit der Tastenkombination Alt + F11 in den VBA-Editor, in dem man nun (standardmäßig) links oben im Projektexplorer den Namen des Add-Ins findet. Doppelklickt man darauf, werden die einzelnen Elemente (Tabellen, Module, usw.) sichtbar und durch einen Doppelklick auf das entsprechende Element sieht man den Code der/des Makros bereits vor sich und kann ihn bearbeiten. Nicht vergessen, zu speichern!

Add-In in normale Excel-Datei umwandeln

Normalerweise sieht man das Add-In nur im VBA-Editor, nicht aber in Excel. Manchmal möchte man aber aus dem Add-In wieder eine "normale" Mappe erstellen, damit man die Tabellen in Excel bearbeiten kann. Das ist auch kein Problem. Man gibt dazu einfach irgendwo diesen Code ein und führt ihn aus. Wechselt man nun nach Excel, hat man als Mappe das Add-In vor sich und kann wie in einer normalen Excelmappe arbeiten:

Sub Test() Workbooks("Name_des_Add-ins.xla").Isaddin = False End Sub

personl.xls

Auch mit einer Datei mit dem Namen PERSONAL.XLSB kann man Makros allgemein verfügbar machen. Dazu wählt man folgende Schritte:

  1. Menü Extras - Makro - Aufzeichnen
  2. Namen des Makros eingeben
  3. Bei Makro speichern in wählen: Persönliche Makroarbeitsmappe
  4. Schritte durchführen, die das Makro später ausführen soll
  5. Aufzeichnung beenden
  6. Excel beenden, Frage nach Speichern mit Ja beantworten
  7. Excel neu starten

Nun ist die Datei PERSONAL.XLSB automatisch gespeichert und wird bei jedem Excelstart mitgeöffnet. Sie kann auch bearbeitet werden, indem man mit Alt + F11 in den Editor wechselt.

Auch wenn oft empfohlen wird, zentrale Makros in dieser Datei zu speichern, rate ich davon ab. Im Unterschied zu einem Add-In ist sie eine Mappe, die beim Excelstart mit aufgerufen wird und kann über das Menü Fenster - Einblenden eingeblendet werden. Daraus könnten sich Probleme ergeben, wenn mit der Workbooks-Auflistung gearbeitet wird. So wirkt sich z. B. folgender Code auch auf die PERSONAL.XLSB aus:

For each x in Workbooks ... Next

Auf ein Add-In wirkt es sich nicht aus.

Menü Format wiederherstellenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 52) Nachricht zum Beitrag an Autor Nach oben

Wie kann man ein Menü in der Menüleiste für Tabellenblätter wiederherstellen, nachdem es irgendwann zuvor gelöscht wurde, zum Beispiel Format?

Hinweis zu Excel 2007: Entfällt, da es das Menü nicht mehr gibt.

Sub MenueWiederherstellen() MenuBars(xlWorksheet).Menus.Add Caption:="Format", Before:=4, Restore:=True End Sub

Menüelement Zelle im Menü Format wiederherstellenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 51) Nachricht zum Beitrag an Autor Nach oben

Wie kann man das Menüelement "Zelle" im Menü Format der Menüleiste für Tabellenblätter wiederherstellen, nachdem es irgendwann zuvor gelöscht wurde?

Hinweis zu Excel 2007: Entfällt, da es das Menü nicht mehr gibt.

Sub MenueelementWiederherstellen() MenuBars(xlWorksheet).Menus("Format"). MenuItems.Add Caption:="Zelle", Restore:=True End Sub

Minuszeichen nach vorn (VBA + Formel)Makro/Sub/ProzedurFormellösung

Kategorie: Stringoperationen ▸ Verketten

(Tipp 137) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich in einer Spalte aus Zahlen, hinter denen das Minuszeichen steht, negative Zahlen erstellen?

Beispiel 1:

Sub Minus() Dim lngZ As Long, lngS As Long, strMZahl As String lngS = 2 'Spalte mit Zahlen For lngZ = 2 To 20 On Error Resume Next strMZahl = Cells(lngZ, lngS) If Right(strMZahl, 1) = "-" Then Cells(lngZ, lngS) = "-" & Replace(strMZahl, "-", "") Next End Sub

Beispiel 2:

Sub Minus() Dim lngZ As Long, lngS As Long, strMZahl As String lngS = 2 'Spalte mit Zahlen For lngZ = 2 To 20 On Error Resume Next strMZahl = Cells(lngZ, lngS) If Right(strMZahl, 1) = "-" Then Cells(lngZ, lngS) = "-" & Left(strMZahl, Len(strMZahl) - 1) Next End Sub

Beispiel 3 als Formeln:

=WENN(RECHTS(A1;1)="-";("-"&LINKS(A1;LÄNGE(A1)-1))*1;A1)

=WENN(RECHTS(A1;1)="-";(-1)*LINKS(A1;LÄNGE(A1)-1);1*A1)

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

Kategorien: Filter/Sortieren und Stringoperationen ▸ Teile

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

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

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

Variante 1

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

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

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

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

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

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

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


Erweiterte Variante mit benutzerdefinierter Funktion (UDF)

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

In dem Fall versagt die erste Variante.

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

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

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

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

Das ist die Funktion:

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

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

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


Microsoft VBScript Regular Expressions

Variante mit regulären Ausdrücken/Regular Expressions

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

Das Suchmuster wäre in diesem Fall:

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

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

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

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


Beschleunigen: Sortieren per Array

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

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

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

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

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

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

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

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

Die Routine als Ganzes:

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

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


Beispieldatei

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

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

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

Download: alphanum_sort.xlsm

Ordner erstellen, wenn nicht vorhandenMakro/Sub/Prozedur

Kategorie: Dateien und Ordner ▸ Ordner

(Tipp 15) Nachricht zum Beitrag an Autor Nach oben

Wie erstellt man einen Ordner, wenn dieser noch nicht existiert?

Es wird geprüft, ob der Ordner existiert. Wenn nicht, wird er erstellt. Ggf. noch daran denken, etwaige Fehler abzufangen.

Dim strPfad As String strPfad = "\\COMPUTER\Ordner\Unterordner\" 'Beispiel für Netzwerk strPfad = "C:\Temp\" 'Beispiel lokal If Dir(strPfad, vbDirectory) <> "" Then MsgBox "Verzeichnis existiert bereits" Else MkDir strPfad End If

Sicherungskopie bei Dateiaufruf

Kategorie: Add-In ▸ Dateien und Ordner

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

Wie kann ich beim Aufruf einer Exceldatei automatisch eine Sicherungskopie erstellen lassen?

Ist das Add-In installiert, wird beim Aufruf einer Datei eine Kopie erstellt. Beim Schließen dieser Datei wird gefragt, ob die Sicherungskopie wieder gelöscht werden soll.

Die Sicherungskopie befindet sich in dem Ordner, in dem sich die aufgerufene Datei befindet. Der Name der Sicherungskopie hat das Format »~JJJJ-MM-TT hh_nn_ss.[Dateiendung].bak. Im Ernstfall kann also einfach die Endung ».bak« gelöscht werden, so dass die Datei in dem Zustand vorliegt, in dem sie vor dem Aufruf (und damit vor etwaigen Bearbeitungen) war.

Im Ribbon des Add-Ins gibt es keinen Befehl zum Aufruf. Das „Überwachen“ und damit das Erstellen von Sicherungskopien erfolgt automatisch, wenn das Add-In offen (bzw. installiert) ist. Der Code dafür befindet sich in Klassenmodulen.

Download: sicherungskopie_bei_dateiaufruf.xlam



Standard-Menüleiste für Tabellenblätter wiederherstellenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 53) Nachricht zum Beitrag an Autor Nach oben

Wie kann man die Standard-Menüleiste für Tabellenblätter wiederherstellen?

Sub MenueleisteWiederherstellen() MenuBars(xlWorksheet).Reset End Sub

Symbolleisten aus- und einblendenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 61) Nachricht zum Beitrag an Autor Nach oben

Wie kann man beim Start einer Arbeitsmappe alle Symbolleisten aus- und eine benutzerdefinierte einblenden, beim Schließen der Arbeitsmappe die vorherigen Einstellungen wiederherstellen?

Hinweis zu Excel 2007: Hier ist es wirkungslos.

Dim Cd As CommandBar Dim Cdb$() Private Sub Workbook_Open() Dim intI As Integer For Each Cd In Application.CommandBars If Cd.Type <> msoBarTypeMenuBar Then If Cd.Visible Then On Error Resume Next intI = intI + 1 ReDim Preserve Cdb(intI) Cdb(intI) = Cd.Name Cd.Visible = False End If End If Next Cd Application.CommandBars("MeineSymbolleiste").Visible = True End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim intI As Integer On Error Resume Next For intI = 1 To UBound(Cdb) Application.CommandBars(Cdb(intI)).Visible = True Next intI Application.CommandBars("MeineSymbolleiste").Visible = False End Sub

Symbolleistenschaltfläche hinzufügenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 60) Nachricht zum Beitrag an Autor Nach oben

Wie kann man der Standardsymbolleiste beim Laden einer bestimmten Arbeitsmappe ein Schaltflächensymbol mit Makrozuweisung und Kurznotiz hinzufügen und beim Schließen der Arbeitsmappe wieder entfernen?

Hinweis zu Excel 2007: In diesem Fall wird im Ribbon Add-Ins ein eigener Bereich erstellt..

Sub Erstellen() Toolbars(1).ToolbarButtons.Add Button:=211 With Toolbars(1).ToolbarButtons(Toolbars(1).ToolbarButtons.Count) .OnAction = "MeinMakro" .Name = "Mein Makro ausführen!" End With End Sub Sub Loeschen() Toolbars(1).ToolbarButtons(Toolbars(1).ToolbarButtons.Count).Delete End Sub

Tabellenblatt auf mehrere Tabellenblätter aufteilen (EINDEUTIG(), FILTER())Makro/Sub/ProzedurArrayfunktion/Matrixfunktion

Kategorien: Mappe ▸ Tabellen und Tabelle ▸ Matrix

(Tipp 551) Nachricht zum Beitrag an Autor Nach oben

Auf einem Tabellenblatt befinden sich in Spalte C die Namen der Mitarbeiter, daneben ihre Daten. Für jeden Mitarbeiter kann es mehrere Zeilen geben. Wie kann ich für jeden Mitarbeiter ein neues Blatt per VBA erstellen, auf dem seine Daten untereinander aufgelistet sind?

Einsatz dynamischer Arrayfunktionen

Ein Lösungsansatz, der allerdings erst ab Excel 365 funktioniert, ist der Einsatz dynamischer Arrayfunktionen. Dadurch können die Daten vorgefiltert werden und per Schleife müssen nur noch die jeweiligen Ergebnismengen verarbeitet werden; eine Schleife über alle Zeilen ist nicht notwendig.

Gegeben ist die Tabelle mit den Namen in Spalte C ab Zeile 2 und Daten bis zur Spalte G. Dies müsste ggf. angepasst werden. Die letzte Zeile der Tabelle wird aufgrund der Daten in C automatisch erkannt.

Zuerst kommt die Tabellenblattfunktion EINDEUTIG() (UNIQUE()) zum Zug. Sie enthält jeden Namen aus Spalte C genau einmal. Dies ist wichtig, da für jeden Mitarbeiter ja nur ein Blatt erstellt werden soll. Über das Ergebnis dieser Formel kann dann die Hauptschleife laufen: For Each varName In varNamen

In der Schleife wird dann für jeden Namen wieder eine Arrayfunktion verwendet: FILTER(). Diese liefert einen Array, der bei mehreren Zeilen zum Mitarbeiter aus diesen Zeilen mit den Zellen besteht oder bei nur einer Zeile aus den einzelnen Zellen. Damit hier kein Fehler auftritt, wird mit If UBound(varFilt) = Application.WorksheetFunction.CountA(varFilt) Then geprüft, wie viele Elemente der Array hat. Ist die Größe des Arrays gleich der Anzahl der einzelnen Elemente, handelt es sich um eine Zeile; die Elemente sind die Zellen. Ist die Größe des Arrays kleiner als die Anzahl der einzelnen Elemente, handelt es sich um mehrere Zeilen.

Beispiel: Bei zwei Zeilen ist der Ubound = 2. Jede Zeile hat vier Zellen, also sind das 2 Zeilen * 4 Zellen = 8 Elemente. Ubound ist kleiner als die Anzahl der Elemente. Bei nur einer Zeile hat der Array vier Elemente (die Zellen eben). Da der Array hier nicht nach Zeilen untergliedert ist, sondern die Zellen in der ersten Ebene liegen, ist hier Ubound auch = 4.

Diese Arrayelemente werden dann nur noch auf das hinzugefügte Blatt eingelesen.

Der Code:

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

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

Kategorie: Dateien und Ordner ▸ Dateioperation

(Tipp 33) Nachricht zum Beitrag an Autor Nach oben

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

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

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

Einlesen in eine Textdatei mit immer gleichem Pfad:

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

Einlesen in eine Textdatei mit wählbarem Pfad:

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

Textdatei in Exceldatei einlesen, immer gleicher Pfad:

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

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

Textdatei in Exceldatei einlesen, wählbarer Pfad:

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

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


Dynamische Arrayformel mit Matrixfunktion

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

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

In die Zelle kommt dann nur noch die Formel:

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

=DateiEinlesen(A1;";";4)

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

Verfügbarkeit von VariablenMakro/Sub/ProzedurTipp

Kategorie: Basics ▸ Variablen

(Tipp 213) Nachricht zum Beitrag an Autor Nach oben

Wird eine Variable innerhalb einer Prozedur deklariert, kann nur der Code innerhalb dieser Prozedur auf den Wert zugreifen oder ändern. Manchmal soll die Variable jedoch in allen Prozeduren oder in allen Prozeduren in einer Arbeitsmappe zur Verfügung stehen. Die Art der Verfügbarkeit einer Variablen wird bei der Deklaration festgelegt. Es gibt drei mögliche Gültigkeitsbereiche für eine Variable:

  • Innerhalb einer Prozedur Dim - Lokal
  • Am Anfang des Modules Dim oder Private - Modulebene
  • Am Anfang des Moduls Public - Öffentlich

Lokal

Die Variable wird nur innerhalb der umgebenen Prozedur erkannt und eignet sich für temporäre Berechnungen. Wird ein Variablen-Name in mehreren Prozeduren benutzt, ist die Variable nur lokal gültig. Gleiche Variablen-Namen in anderen Prozeduren bleiben unverändert vom Wert. Jede Prozedur erkennt nur ihre eigene Variablen.

Sub Test() Dim MeineVariable ... ... End Sub Sub Test2() Dim MeineVariable '(Lokale Variable mit gleichem Namen wie in Prozedur Test, 'entspricht nicht der Variablen von Prozedur Test) ... ... End Sub

Soll im Beispiel in der Routine Test2 auch die Variable MeineVariable verwendet werden, kann sie bei dieser Art der Deklaration übergeben werden, wenn z. B. die zweite Routine durch die erste aufgerufen werden soll:

Sub Test() Dim MeineVariable ... ... Test2 MeineVariable End Sub Sub Test2(ByVal MeineVariable As String) 'Hier kann MeineVariable weiterverwendet werden. End Sub

Modulebene

Variablen auf Modulebene haben aus allen Prozeduren innerhalb eines Moduls Gültigkeit. Variablen aus anderen Modulen haben keine Gültigkeit.

Dim MeineVariable '(Variable auf Modulebene) Private MeineVariable1 Sub Test() ... ... ... End Sub

Öffentlich

Variablen, die mit Public deklariert wurden, haben die umfassendste Gültigkeit. Öffentliche Variablen stehen jeder Prozedur, die sich in einem beliebigen Modul der jeweiligen Arbeitsmappe befinden kann, zur Verfügung. Öffentliche Variablen werden genau wie Variablen auf Modulebene allgemeiner Module vor den Prozedurdefinitionen deklariert.

Public MeineVariable 'Öffentliche Variable Public MeineVariable1 Sub Test() ... ... ... End Sub

Tipp

Wer viel mit Variablen, die immer zur Verfügung stehen müssen, arbeitet, sollte sich mit Klassenmodulen beschäftigen. Damit kann man eigene Objekte erstellen, denen man Eigenschaften zuweist, die dann immer zur Verfügung stehen. So könnte ein Autohändler zum Beispiel das Objekt Auto erstellen, für dieses Objekt die Eigenschaft Farbe. Im Code braucht man dann nur noch zu schreiben:

Auto.Farbe = "rot" ... ... MsgBox Auto.Farbe

Vornamen und Nachnamen trennenMakro/Sub/ProzedurUDF - benutzerdefinierte FunktionTipp

Kategorie: Stringoperationen ▸ Teile

(Tipp 124) Nachricht zum Beitrag an Autor Nach oben

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

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

Schleife über die Zellen

Variante 1:

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

Variante 2:

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

Text in Spalten

Variante 3:

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

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


Dynamische Arrayformel mit Matrixfunktion

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

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

In die Zelle kommt dazu diese überlaufende Formel:

=NamenTrennen(A1)

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

=NamenTrennen(A1;4)

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



Wo gibt man die Makros ein?

Kategorie: VBE

(Tipp 93) Nachricht zum Beitrag an Autor Nach oben

Wo gibt man die Makros ein?

Das herausstechendste Merkmal ist, dass die Programmiersprache VBA bei den Office-Anwendungen fast einheitlich ist; das Vorgehen ist hier also bei Excel, Word, usw. gleich.

Die Eingabe der Makros erfolgt im sogenannten VBA-Editor, den man mit Alt + F11 aufruft. Nach dem Aufruf erscheint normalerweise erst ein leeres Fenster, in dem sich oben links der Projekt-Explorer befindet (wenn nicht, im Menü Ansicht einblenden).

Projekt-Explorer

In diesem Projekt-Explorer sind alle offenen Excel-Dateien aufgelistet. Das heißt, wenn man in einer bestimmten Datei arbeiten möchte, muss sie vorher dort aktiviert werden. Durch einen Doppelklick auf eine Datei oder einen Klick auf das Pluszeichen vor der Datei werden die einzelnen Elemente der Datei - wie im Windows-Explorer - sichtbar. Bei einer sonst leeren Datei dürften das nur die Einträge für DieseArbeitsmappe und für die einzelnen Tabellen sein. Das heißt, dass die einzelnen Module für die Makros erst erzeugt werden müssen.

Userform

Manchmal bietet es sich an, eigene Masken oder Bedienungselemente zu erstellen. Dies erfolgt in VBA mit Userformen, die man über das Menü Einfügen - Userform erstellt. Dort kann man seine eigenen Elemente zeichnen und diese programmieren.

Klassenmodule für Tabellen oder die Mappe

Soll ein Makro direkt einer Tabelle, der Mappe oder einer Userform zugeordnet werden, erreicht man das Erstellen des entsprechenden Klassenmoduls, indem man im Projekt-Explorer einen Doppelklick auf das gewünschte Element ausführt. Beachten Sie dabei aber, dass diese Klassenmodule normalerweise nur dann gebraucht werden, wenn bestimmte Ereignisse des Elements Öffnen, Speichern, Eingaben, Markieren, usw.) abgefangen, also darauf reagiert werden sollen. Im Normalfall ist es besser, allgemeine Module zu verwenden.

Allgemeines Modul

Normalerweise beginnt man mit Makros in allgemeinen Modulen, wo auch der Makrorecorder seine Makros aufzeichnet. Diese allgemeinen Module sind - wie der Name besagt - allgemein verfügbar und es kann von überall aus darauf zugegriffen werden. Ein solches Modul erzeugt man mit dem Menü Einfügen - Modul. Dadurch hat man ein leeres weißes Blatt, in dem man mit dem Makros beginnen kann. Im Projekt-Explorer ist nun auch der neue Eintrag Modul1 unter dem Sammeleintrag Module enthalten. Dies sollte für den Anfang der wichtigste Ausgangspunkt sein, die anderen Module werden dort benannt, wo sie gebraucht werden.

Zusammenfassung

Bei der Gesamtheit der Elemente einer Mappe oder eines Dokumentes spricht man vom VBA-Projekt.

Dieses kann zum Beispiel aus folgenden Elementen bestehen:

  • Excel- bzw. Word-Objekte (Arbeitsmappe, einzelne Tabellen, Document) und die zugehörigen Ereignisprozeduren,
  • Userformen und die zugehörigen Prozeduren,
  • Module,
  • Klassenmodule (siehe Ereignisprozeduren)

Zellkontextmenü wiederherstellenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 55) Nachricht zum Beitrag an Autor Nach oben

Wie kann man das Zellkontextmenü wiederherstellen?

Sub KontextmenueWiederherstellen() CommandBars("Cell").Reset End Sub

Zufallszahlen sortiert in einem bestimmten Bereich generieren (mit Arrayfunktion)Makro/Sub/ProzedurUDF - benutzerdefinierte FunktionArrayfunktion/Matrixfunktion

Kategorien: Tabelle ▸ Zellen und Filter/Sortieren

(Tipp 139) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich zwischen 6 und 15 Zufallszahlen zwischen 1 und 49 generieren? Die Zahlen sollen auf dem Blatt Tab1 in der Zeile 1 ab A1 stehen. Keine Zahl darf sich wiederholen.

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.