Sortieren von Alphanumerischen Zellen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Tobi,
... und zwar bzgl. Deiner Sortierungsvorgabe was die reinen Zahlenwerte angeht. Die Logik Deiner sonstigen Sortierung würde vor 10002 mE die 10001a erfordern und und nicht danach. Oder?
Dafür hätte ich eine (zugegeben momentan noch aufwendigen Weg) zu einer Formellösung zu kommen. Die zusätzlich noch einen händischen Zwischenschritt bedarf. Mit VBA lässt sich das sicherlich einfacher realisieren.
Hier mein momentaner Vorschlag mit zwei Hilfsspalten in C und D.
In C2: =WECHSELN(A2;VERWEIS(9^9;1*LINKS(A2;SPALTE(A2:AB2)));"")&" --" und dies nach unten kopieren und anschließend die komplette Liste nach Spalte C (aufwärts) sortieren (wichtig)
Anschließend in D2: =AGGREGAT(15;6;1*WECHSELN(A$2:A$39;LINKS(C$2:C$39;LÄNGE(C$2:C$39)-3);"");ZEILE(A1)) und ziehend nach unten kopieren.
Dann in E2: =D2&WECHSELN(INDEX(C:C;AGGREGAT(15;6;ZEILE(A$2:A$39)/((LINKS(A$2:A$39;LÄNGE(D2))=D2&""));ZÄHLENWENN(D$2:D2;D2)));" --";"") und dies ziehend nach unten kopieren.
Im Ergebnis erhalte ich mit der erwähnten Ausnahme die gewünschte Sortierreihenfolge,
Die händische Sortierung könnte ich in die Formel(n) noch einbauen. Aber für Heute mach ich Schluss und Morgen bin ich wahrscheinlich nicht online. Deshalb stelle ich dies jetzt erst einmal so ein wie es jetzt ist.
Gruß Werner
.. , - ...

Hallo,
beliebig iele Spalten daneben:

Sub Sortieren()
Dim vntSortArray As Variant
Dim vntArray As Variant
Dim arr1 As Variant
Dim ws As Worksheet
Set ws = ActiveSheet
With Cells(1, 1).CurrentRegion
arr1 = .Offset(1).Resize(.Rows.Count - 1)
End With
vntArray = InhaltSplitten(arr1, 1)
vntSortArray = Array(UBound(vntArray, 2) - 1, UBound(vntArray, 2))
Call prcSort(vntSortArray, vntArray)
Sheets.Add
ws.Cells(1, 1).Resize(, UBound(arr1, 2)).Copy Cells(1, 1)
Cells(2, 1).Resize(UBound(arr1, 1), UBound(arr1, 2)) = vntArray
End Sub

Function InhaltSplitten(arr As Variant, SplitSpalte As Long) As Variant
Dim arrSplit() As Variant
Dim i As Long
Dim j As Long
Dim k As Long
ReDim arrSplit(1 To UBound(arr, 1), 1 To UBound(arr, 2) + 2)
For i = LBound(arr) To UBound(arr)
For j = 1 To Len(arr(i, SplitSpalte))
If Not IsNumeric(Mid(arr(i, SplitSpalte), j, 1)) Then
For k = 1 To UBound(arr, 2)
arrSplit(i, k) = arr(i, k)
Next k
If j = 1 Then
arrSplit(i, k) = ""
Else
arrSplit(i, k) = CLng(Left(arr(i, 1), j - 1))
End If
arrSplit(i, k + 1) = Right(arr(i, 1), Len(arr(i, 1)) - j + 1)
Exit For
End If
If j = Len(arr(i, SplitSpalte)) Then
For k = 1 To UBound(arr, 2)
arrSplit(i, k) = arr(i, k)
Next
arrSplit(i, k) = CLng(arr(i, 1))
End If
Next j
Next i
InhaltSplitten = arrSplit
End Function

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Sortieren von Alphanumerischen Zellen

22 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

22
Beiträge zum Forumthread

Beiträge zu diesem Forumthread