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
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
Suchergebnisse (9 Treffer, 1 Begriff) 
Kategorien: 
