Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Sortierung von 1.2.3 usw.

Sortierung von 1.2.3 usw.
22.09.2014 22:55:27
1.2.3
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

Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sortierung von 1.2.3 usw.
22.09.2014 23:48:45
1.2.3
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

Anzeige
Perfekt, Danke Daniel! Servus, Walter
23.09.2014 06:32:08
WalterK
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige