Microsoft Excel

Herbers Excel/VBA-Archiv

Sortierung von 1.2.3 usw.

Betrifft: Sortierung von 1.2.3 usw. von: WalterK
Geschrieben am: 22.09.2014 22:55:27

Hallo,

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

  

Betrifft: AW: Sortierung von 1.2.3 usw. von: Daniel
Geschrieben am: 22.09.2014 23:48:45

Hi
Probiere mal das.
Ist für 3 Untergruppen mit maximal 99 Positionen.

Option Explicit
Sub Sortieren123()

Dim rngZelle As Range
Dim i As Long
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)
    myarr = Split(rngZelle.Text, ".")
    
    For i = 0 To UBound(myarr)
        myarr(i) = Right("00" & myarr(i), 2)
    Next
    rngZelle.Offset(0, 1).Value = CLng(Left(Join(myarr, "") & "000000", 6))
Next
    
    

       
        Range("A4:B" & Lz).Sort Key1:=Range("B4"), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

End Sub

Gruß Daniel


  

Betrifft: Perfekt, Danke Daniel! Servus, Walter von: WalterK
Geschrieben am: 23.09.2014 06:32:08




 

Beiträge aus den Excel-Beispielen zum Thema "Sortierung von 1.2.3 usw."