abwechselndes sortieren

Hallo Leute,
ich habe eine Tabelle die ich mit VBA sortieren möchte. Die Tabelle beinhaltet einen Code der immer gleich aussieht z.B.
8A513C
8A110I
8P101K
8P416Z
8I333A
8O963Z
....
Die erste Zahl ist immer gleich. Ich soll jedoch dann zuerst nach dem zweiten Zeichen (also dem Buchstaben) absteigend sortieren. Und anschließend die 3-stellige Zahl immer abwechselnd für den ersten Buchstaben aufwärts, für den zweiten Buchstaben abwärts, für den dritten Buchstaben aufwärts und so weiter. Die Anzahl der Codes ist unterschiedlich, also kann man nicht sagen wieviele Einträge es sind. Ich hoffe ihr versteht was ich meine. Es soll dann so aussehen:
8O963Z
8P416Z
8P101K
8I333A
8A513C
8A110I
Bis jetzt habe ich nur die Sortierung nach dem Buchstaben geschafft.
Bitte um Hilfe!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Sortieren() Dim lastrow As Double Dim Row As Double lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "G").End(xlUp).Row With Tabelle5 Range(Cells(4, 1), Cells(lastrow, 26)).Sort Key1:=Range("G" & "1"), Order1:=xlDescending, _ Header:=xlNo End With End Sub

Hallo Hans,
hier mal ein kleiner Beispielcode, wie du das machen kannst. Hier wird Spalte A ab Zeile 1 nach deinem Wunsch sortiert.

Sub Sortieren()
Dim lastrow As Double
Dim lngRow As Long
Dim lngStart As Long
Dim lngEnde As Long
Dim bolSortDirAsc As Boolean
lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "G").End(xlUp).Row
Range(Cells(4, 1), Cells(lastrow, 26)).Sort Key1:=Range("G" & "1"), _
Order1:=xlDescending, Header:=xlNo
lngRow = 1
bolSortDirAsc = True
Do Until Cells(lngRow, 1).Value = ""
lngStart = lngRow
Do Until Not Mid(Cells(lngRow, 1).Value, 2, 1) = Mid(Cells(lngRow + 1, 1).Value, 2, 1)
lngRow = lngRow + 1
Loop
lngEnde = lngRow
If bolSortDirAsc Then
MySort lngStart, lngEnde, "Asc"
Else
MySort lngStart, lngEnde, "Desc"
End If
lngRow = lngRow + 1
bolSortDirAsc = Not bolSortDirAsc
Loop
End Sub
Function MySort(lngStart As Long, lngEnde As Long, sortDir As String)
Dim lngZeile As Long
Dim lngZeile2 As Long
Dim merkInhalt
If sortDir = "Asc" Then
For lngZeile = lngStart To lngEnde
For lngZeile2 = lngZeile To lngEnde
If Mid(Cells(lngZeile, 1).Value, 3, 3) > Mid(Cells(lngZeile2, 1).Value, 3, 3)  _
Then
merkInhalt = Cells(lngZeile, 1).Value
Cells(lngZeile, 1).Value = Cells(lngZeile2, 1).Value
Cells(lngZeile2, 1).Value = merkInhalt
End If
Next lngZeile2
Next lngZeile
Else
For lngZeile = lngStart To lngEnde
For lngZeile2 = lngZeile To lngEnde
If Mid(Cells(lngZeile, 1).Value, 3, 3)

Gruß Worti

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread