Software für Sie.

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!

Der Code nimmt sich die erste Exceldatei, die im Ordner in der Variablen ist. Die ruft er auf, druckt deren erstes Blatt und schlie�t sie wieder. Mit Dir() wird nun die nächste Datei genommen und die gleiche Prozedur erneut ausgeführt - so lange, bis mit Dir() keine weitere Datei gefunden wird.

Sub AlleDrucken() Dim WB As Workbook Dim strFName As String strFName = Dir("C:\Excel\*.xls") While strFName <> "" Set WB = Workbooks.Open(Filename:=strFName) WB.PrintOut WB.Close strFName = Dir() Wend End Sub

Der Code funktioniert zwar, wie er hier angegeben ist. Allerdings ist die Gefahr eines Fehlers gro�, wenn bereits Dateien geöffnet sind. Zumindest die Prüfung darauf sollte noch mit eingebaut werden.

Im Zusammenhang damit muss auch beachtet werden, ob eine offene Datei gespeichert ist. Wenn nicht, kommt es beim SchlieÃ?en zur entsprechenden â??Speichern?â??-Frage durch Excel und der Code wird angehalten.

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.

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

Evaluate()

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

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

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

Rückgabe: Array

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

Die Bereiche in den Arrays aus Arrayformeln sind grundsätzlich in Zeilen gegliedert, sie sind die erste Dimension. Wenn wir nun also in C2:C7 Einträge haben und mit arr = Evaluate("=C2:C7") (statt Evaluate wäre auch Range("C2:C7") möglich) darauf zugreifen, wird als Ubound folgerichtig die 6 ausgegeben. Entsprechend kann mit einer Schleife For intI = 1 To UBound(arr) über die einzelnen Elemente des Arrays gegangen werden.

Allerdings muss jetzt beachtet werden, dass die einzelnen Werte in der ersten Spalte des Arrays stehen - das erste (und in diesem Beispiel einzige) Element in der zweiten Dimension. Ein Zugriff auf arr(intI) würde einen Fehler erzeugen, da hier die Angabe der Spalte fehlt. Erst mit dieser Angabe wird der gewünschte Eintrag geliefert: arr(intI, 1).

Der Aufbau des Codes wäre also:

Sub Test() Dim arr, intI As Integer, strTemp As String arr = Evaluate("=C2:C7") MsgBox "Einträge: " & UBound(arr) For intI = 1 To UBound(arr) strTemp = arr(intI, 1) ' Einträge in Zeilen! MsgBox "Eintrag " & intI & ": " & strTemp Next End Sub

Im Beispiel standen die Werte untereinander in den Zellen. Was nun aber, wenn die Werte nebeneinander stehen, zum Beispiel in D1:I1?

In diesem Fall besteht der Array nur aus einer Zeile, der Ubound wird somit 1 sein.

Um an die einzelnen Elemente zu gelangen, gibt es nun die erste Möglichkeit, per Schleife die Elemente dieser einen Zeile zu liefern, wobei allerdings bekannt sein muss, wie viele Elemente die Zeile hat:

For intI = 1 To 6 strTemp = arr(1, intI) ' Einträge in Spalten! MsgBox "Eintrag " & intI & ": " & strTemp Next

Eine Alternative dazu ist, den Array zu transponieren. Dies geht mit der Funktion MTRANS() in der englischen Schreibweise bereits beim Ã?bergeben an die Variable:

arr = Application.WorksheetFunction.Transpose(Evaluate("=D1:I1"))

Damit sind die ehemaligen Spalten nun die Zeilen und der Array kann wie vorher mit Schleife bis zum Ubound (der jetzt im Beispiel wieder 6 ist) durchlaufen werden.

Der Code zum Testen:

Sub Test1() Dim arr, intI As Integer, strTemp As String arr = Evaluate("=D1:I1") MsgBox "Einträge: " & UBound(arr) ' 1, weil nur 1 Zeile For intI = 1 To 6 strTemp = arr(1, intI) ' Einträge in Spalten! MsgBox "Eintrag " & intI & ": " & strTemp Next End Sub Sub Test2() Dim arr, intI As Integer, strTemp As String arr = Application.WorksheetFunction.Transpose(Evaluate("=D1:I1")) MsgBox "Einträge: " & UBound(arr) For intI = 1 To 6 strTemp = arr(intI, 1) ' Einträge in Spalten! MsgBox "Eintrag " & intI & ": " & strTemp Next End Sub

Zum Sortieren der Blätter gibt es verschiedene Möglichkeiten, was auch etwas von den Rahmenbedingungen abhängig ist. Was soll zum Beispiel mit Blättern passieren, deren Namen nicht der Syntax der zu sortierenden Blattnamen entsprechen? Hier sind drei Beispiele, die ggf. noch angepasst werden müssen.

In dem Fall werden unterwegs (also nicht am Anfang) Blätter mit Namen, die nicht der Syntax entsprechen, nach hinten verschoben - ansonsten wird so lange sortiert, bis die Zahl im folgenden Blattnamen nicht mehr gö�er ist:

Sub BlaetterSortieren() Dim bolSortiert As Boolean Dim intBlatt As Integer, intBlatt1 As Integer Dim varAkt, varNaechst bolSortiert = False Do While bolSortiert = False bolSortiert = True For intBlatt = 1 To Sheets.Count varAkt = Replace(Sheets(intBlatt).Name, "Tab", "") If IsNumeric(varAkt) Then For intBlatt1 = intBlatt To Sheets.Count varNaechst = Replace(Sheets(intBlatt1).Name, "Tab", "") If IsNumeric(varNaechst) Then If varNaechst * 1 < varAkt * 1 Then Sheets(intBlatt1).Move Before:=Sheets(intBlatt) bolSortiert = False End If Else Sheets(intBlatt1).Move after:=Sheets(Sheets.Count) End If Next End If Next Loop End Sub

Ein Beispiel mit Sprungmarken, Reihenfolge Tab1, Tab2, Tab11:

Sub Blattsort() Dim intAnzahl As Integer, intN As Integer, intM As Integer, intI As Integer, intZahlM As Integer, intZahlN As Integer Dim WS As Worksheet intAnzahl = ActiveWorkbook.Worksheets.Count For intM = 1 To intAnzahl For intN = intM To intAnzahl On Error Resume Next For intI = 1 To Len(Worksheets(intN).Name) If IsNumeric(Right(Worksheets(intN).Name, intI)) = False Then intI = intI - 1 If intI = 0 Then GoTo TEXT intZahlN = Right(Worksheets(intN).Name, intI) Exit For End If Next intI For intI = 1 To Len(Worksheets(intM).Name) If IsNumeric(Right(Worksheets(intM).Name, intI)) = False Then intI = intI - 1 If intI = 0 Then GoTo TEXT intZahlM = Right(Worksheets(intM).Name, intI) Exit For End If Next intI If CInt(intZahlN) < CInt(intZahlM) Then Worksheets(intN).Move Before:=Worksheets(intM) GoTo NAECHSTE TEXT: If Worksheets(intN).Name < Worksheets(intM).Name Then Worksheets(intN).Move Before:=Worksheets(intM) NAECHSTE: Next intN Next intM MsgBox "Anzahl der Tabellen: " & intAnzahl End Sub

Ein kurzes Beispiel, aber die Reihenfolge ist Tab1, Tab11, Tab2:

Sub Blattsort1() Dim intX As Integer Dim bolY As Boolean Do bolY = True For intX = 1 To Sheets.Count - 1 If Sheets(intX).Name > Sheets(intX + 1).Name Then Sheets(intX + 1).Move Before:=Sheets(intX) bolY = False End If Next intX Loop Until bolY = True End Sub

Der Code leert zunächst die Listbox. Anschlie�end zeigt er den Dialog zur Dateiwahl, in dem die gewünschte Datei gewählt werden kann. Der Dialog wird so lange gezeigt, bis Abbrechen gewählt wird.

Bei der Listbox handelt es sich um ein ActiveX-Steuerelement

Sub DateienSammeln() Dim varPfad ActiveSheet.ListBox1.Clear varPfad = "" Do While varPfad <> False varPfad = Application.GetOpenFilename("Excel-Dateien (*.xl*), *.xl*") If varPfad <> False Then ActiveSheet.ListBox1.AddItem varPfad Loop End Sub

Wenn vorher bekannt ist, wie viele Unterstriche enthalten sein können, kann das verwendet werden:

Sub Unterstriche() Dim intI As Integer Application.ScreenUpdating = False '10 = maximale Zahl der Unterstriche For intI = 1 To 10 Range("A1:A65536").Replace What:="__", Replacement:="_", LookAt:=xlPart, SearchOrder:=xlByRows Next Range("A1").Select Application.ScreenUpdating = True End Sub

Ansonsten kann auch eine While-Schleife so lange laufen, wie noch doppelte Unterstriche gefunden werden:

Dim objGef As Object Set objGef = Cells.Find("__") Do While Not objGef Is Nothing Cells.Replace "__", "_" Set objGef = Cells.Find("__") Loop

Variante mit regulären Ausdrücken:

Sub Doppelte_Unterstriche() Dim strRepl As String, rngZelle As Range Dim Regex As Object, regMatches, regMatch If Regex Is Nothing Then Set Regex = CreateObject("VBScript.RegExp") strRepl = "_" Regex.Global = True Regex.Pattern = "(__+)" For Each rngZelle In ActiveSheet.UsedRange Set regMatches = Regex.Execute(rngZelle) rngZelle = Regex.Replace(rngZelle, strRepl) Next Set Regex = Nothing End Sub

Beispiel 1:

Manchmal ist bei Eingaben wichtig, dass es sich wirklich um eine Zahl handelt. Deshalb wird in diesem Beispiel mittels einer Schleife solange abgefragt, bis wirklich eine Zahl eingegeben wurde:

Sub Fehlermakro() Dim varI varI = "" Do While Not IsNumeric(varI) varI = InputBox("Bitte geben Sie eine Zahl ein:", "Zahl eingeben") Loop MsgBox varI End Sub

Beispiel 2:

Eingabeaufforderung: da intI als Zahl deklariert ist, dürfen auch nur Zahlen eingegeben werden. Gibt man einen Text ein, tritt der Fehler 13 auf und es wird zur Sprungmarke Fehler: gesprungen.

Wird korrekt eine Zahl eingegeben, erscheint die Zahl als Meldung und das Makro wird verlassen.

Sub Fehlermakro1() Dim intI As Integer On Error GoTo Fehler intI = InputBox("Bitte geben Sie eine Zahl ein:", "Zahl eingeben") MsgBox intI Exit Sub 'Fehlerbehandlung: Fehler: 'Wenn der Fehler 13 aufgetreten ist ... If Err.Number = 13 Then '... eine Meldung bringen ... MsgBox "Sie haben keine gültige Zahl eingegeben.", vbOKOnly + vbExclamation, "Fehler!" 'bei einem anderen Fehler eine Meldung bringen Else MsgBox "Ein unerwarteter Fehler ist aufgetreten. Das Makro wird beendet.", vbOKOnly + vbCritical, "Unerwarteter Fehler" End If Err.Clear End Sub

Download: fehlerbehandlung.xlsm

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

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

Oder einfach per UsedRange:

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

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

Variante 1

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

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

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

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

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

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

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

Erweiterte Variante mit benutzerdefinierter Funktion (UDF)

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

In dem Fall versagt die erste Variante.

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

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

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

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

Das ist die Funktion:

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

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

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

Variante mit regulären Ausdrücken/Regular Expressions

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

Das Suchmuster wäre in diesem Fall:

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

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

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

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

Beschleunigen: Sortieren per Array

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

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

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

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

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

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

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

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

Die Routine als Ganzes:

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

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

Beispieldatei

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

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

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

Download: alphanum_sort.xlsm

Eine Schleife ist das wiederholte Abarbeiten eines Befehls oder einer Folge von Befehlen, bis eine bestimmte Bedingung erfüllt ist. Wird keine oder eine falsche Bedingung vorgegeben, wird die Schleife nicht abgebrochen. Dann spricht man von einer Endlosschleife. In VBA kann sie dafür sorgen, dass die ausführende Anwendung (hier also z. B. Excel) einfriert, also nicht mehr reagiert.

1. For-Schleife

In dieser Schleife verändert die Variable i ihren Wert von 1 bis 5 in Einerschritten, der letzte Wert ist also vorgegeben (Abbruchbedingung). Für jeden Wert wird eine Meldung ausgegeben.

Sub Schleife() For i = 1 To 5 MsgBox i Next i End Sub

2. While-Schleife:

Auch in dieser Schleife verändert die Variable i ihren Wert, der zuerst mit 1 festgelegt ist. Aber mit Do While i <= 5 wird festgelegt, da� die Schleife so lange zu durchlaufen ist, wie der Wert von i kleiner oder gleich 5 ist. Bei jedem Durchlauf soll die Meldung i ausgegeben und i um den Wert 1 erhöht werden.

Sub Schleife2() i = 1 Do While i <= 5 MsgBox i i = i + 1 Loop End Sub

In VBA gibt es bei While noch einige andere Varianten. So kann die Ausführungsdauer am Ende definiert werden (Loop While �) oder es kann auch eine Bis-Bedingung festgelegt werden (Do Until � oder Loop Until).

3. Sprungmarke:

Hier hat die Variable i auch den Startwert 1. Aber im Unterschied zu den anderen Beispielen wird hier mit einer If-Then-Else-Abfrage gearbeitet. Wenn i kleiner oder gleich 5 ist, soll die Meldung i erscheinen, anschlie�end zu i der Wert 1 addiert und bei der Sprungmarke nochmal: fortgesetzt werden. Wenn i im Beispiel den Wert 6 hat, ist die Bedingung i <= 5 nicht erfüllt, die Abfragebedingung ist nicht mehr erfüllt; somit werden die Schritte zwischen If und End If nicht mehr durchgeführt.

Sub Schleife3() i = 1 nochmal: If i <= 5 Then MsgBox i i = i + 1 GoTo nochmal End If End Sub

Hinweis: Die Arbeit mit Sprungmarken ist veraltet und kein guter Stil. AuÃ?erdem handelt es sich dabei eigentlich nicht um eine wirkliche Schleife.

4. Endlosschleife:

Bei dieser Schleife handelt es sich um eine Endlosschleife. Es wurde eine falsche Abbruchbedingung festgelegt (i >= 1); i wird in diesem Beispiel immer grö�er oder gleich 1 sein. Deshalb wird die Schleife ohne Ende weitergeführt. Hier kann die Schleife nur mit Esc abgebrochen werden (wenn kein Dialogfeld aktiv ist) bzw. mit Strg + Pause. Oder im Ernstfall mit Strg + Alt + Entf.

Sub Schleife4() i = 1 Do While i >= 1 i = i + 1 Loop End Sub

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.

In Spalte A stehen ab Zeile 1 die Linkbezeichnungen, also das, was als Text erscheint. In Spalte B stehen die Adressen (URLs).

Formel

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

VBA

Die Routine erstellt die Links (<a href), speichert sie in einer Textdatei und ruft diese im Editor auf:

Sub In_Link_konvertieren() Dim lngDNr As LongPtr, lngZ As LongPtr, strLink As String, strPfad As String strPfad = "c:\eigene dateien\temp\test.txt" 'Datei mit HTML-Code lngZ = 1 'erste Zeile mit Angaben lngDNr = FreeFile Open strPfad For Output As #lngDNr Do While Cells(lngZ, 1) <> "" 'Schleife, solange die nächste Zelle nicht leer ist '�bernehmen der Daten in die Textdatei strLink = "<a href=" & Chr(34) & Cells(lngZ, 2) & Chr(34) & ">" & Cells(lngZ, 1) & "</a>" Print #lngDNr, strLink lngZ = lngZ + 1 Loop Close #lngDNr Shell "notepad.exe " & strPfad & "", vbMaximizedFocus End Sub

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

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

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.