Sortierung von 1.2.3 usw.
22.09.2014 22:55:27
1.2.3
der folgende Code aus dem Internet legt in Spalte B eine Hilfsspalte für eine Sortierung der Spalte A an. Dann werden beide Spalten nach B sortiert.
Allerdings funktioniert die Sortierreihenfolge nicht immer richtig. Ich habe in der Tabelle den entsprechenden Bereich mit Rahmen versehen.
https://www.herber.de/bbs/user/92756.xlsm
Wer weiß Rat!
Danke für die Hilfe und Servus, Walter
Hier noch der Code:
Option Explicit
Sub Sortieren123()
Dim rngZelle As Range
Dim intLänge As Integer
Dim i As Integer
Dim myarr As Variant
Dim Lz As Long
Lz = Application.Max(4, Cells(Rows.Count, 1).End(xlUp).Row)
For Each rngZelle In Range("A4:A" & Lz)
intLänge = Len(rngZelle) - Len(WorksheetFunction _
.Substitute(rngZelle, ".", ""))
Select Case intLänge
Case 0
rngZelle.Offset(0, 1) = rngZelle * 10 ^ 4
Case 1
ReDim myarr(intLänge)
myarr = Split(rngZelle, ".")
rngZelle.Offset(0, 1) = myarr(0) * 10 ^ 4 + myarr(1) * 10 ^ 3
Case 2
ReDim myarr(intLänge)
myarr = Split(rngZelle, ".")
rngZelle.Offset(0, 1) = myarr(0) * 10 ^ 4 + myarr(1) * 10 ^ 3 _
+ myarr(2) * 10 ^ 2
Case 3
ReDim myarr(intLänge)
myarr = Split(rngZelle, ".")
rngZelle.Offset(0, 1) = myarr(0) * 10 ^ 4 + myarr(1) * 10 ^ 3 _
+ myarr(2) * 10 ^ 2 + myarr(3) * 10 ^ 1
Case 4
ReDim myarr(intLänge)
myarr = Split(rngZelle, ".")
rngZelle.Offset(0, 1) = myarr(0) * 10 ^ 4 + myarr(1) * 10 ^ 3 _
+ myarr(2) * 10 ^ 2 + myarr(3) * 10 ^ 1 + myarr(4)
End Select
Next
Range("A4:B" & Lz).Sort Key1:=Range("B4"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub