Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1380to1384
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

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

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

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige