alphanumerisch sortieren mit VBA

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo, Harald,
hier einmal eine Möglichkeit der Zerlegung Deiner Kennzahl

	A	B	C	D	E
1	Kennung	Titel	K1	K2	K3
2	D43S	Buch001	D	43	S

Formeln der Tabelle

C2 : =LINKS(A2;1)&WENN(CODE(TEIL(A2;2;1))>64;TEIL(A2;2;1);"")
D2 : =WERT((TEIL(A2;LÄNGE(C2)+1;LÄNGE(A2)-LÄNGE(C2)-LÄNGE(E2))))
E2 : =WENN(CODE(RECHTS(A2;1))>64;RECHTS(A2;1);"")

Diagramm - Grafik - Excel Tabellen einfach im Web darstellen Excel Jeanie HTML 3.0 Download
Wenn Du die Möglichkeit hast entsprechende Hilfsspalten, wie hier die Spalten C, D uns E, anzufügen, dann kannst Du die Zellenformeln dort hineinschreiben, herunter kopieren und anschließend nach diesen Spalten Sortieren lassen.
Für das Trennen innerhalb eines VBA-Codes gelten ähnliche Anweisungen, nur das hier die engliche Wörter verwendet werden (Left, Mid, Right und Len).
Die größere Arbeit wird jedoch der Sortieralgo. sein, wenn nicht mit (temporären) Hilfsspalten oder einer Hilfstabelle gearbeitet werden soll.
Sofern also eine VBA-Lösung angestrebt werden soll, wäre es vorteilhaft, ein Tabellenbalt mit ein paar Beispieleintragungen als Grundlage nutzen zu können (soll die Ausgangsreihenfolge erhalten bleiben?).
Gruß,
Uwe

Hallo, Harald,
nachflgende Programmroutine AlphaNumerischesSortieren() habe ich in Deine Beispieldatei (siehe Verweis am Ende dieses Beitrages) Standardmodulordner zugefügt.
Option Explicit Const WSNAME = "Buchliste" Const HEADERROW = 1 Const KENNCOLUMN = "A" Sub AlphaNumerischesSortieren() Dim ws As Worksheet Dim K0 As String, K1() As String, K2() As Integer, K3() As String Dim FirstRow As Long, LastRow As Long, LastColumn As Integer Dim maxItems As Long, idx As Long Dim OldUS As Boolean, OldCalc As Integer OldUS = Application.ScreenUpdating 'Schaltet aktualisierung des Bildschirmes aus 'Zeile ist auszukommentieren, wenn man im Debugmodus 'den Aufbau der Hilfsspalten verfolgen möchte Application.ScreenUpdating = False OldCalc = Application.Calculation 'Schalte automatisches Auswertung von Zellenformeln ab Application.Calculation = xlCalculationManual Set ws = Worksheets(WSNAME) ws.Select 'Erste Daten-Zeile FirstRow = HEADERROW + 1 'Letzte Daten-Zeile (letzte beschriebenen Zeile in der Spalte der Kennungen) LastRow = Cells(Rows.Count, KENNCOLUMN).End(xlUp).Row 'letzte beschriebene Spalte in der Überschriftsreihe 'ACHTUNG: Die letzte Daten-Spalte in der Überschiftszeile muß beschriftet sein! LastColumn = Cells(HEADERROW, Columns.Count).End(xlToLeft).Column 'Anzalhl der Datensätze maxItems = LastRow - HEADERROW For idx = 1 To maxItems 'Lese Kennung für Datensatz idx K0 = Cells(HEADERROW + idx, KENNCOLUMN) 'Ermittle Alpha-Präfix 'WENN das 2.Zeichen einen ASCII-Code > 64 hat (CHR(65)="A"!), 'DANN lese die beiden ersten Zeichen 'SONST das erste Zeichen := IIf(asc(Mid(KO,2,1))>64, 2, 1) K1 = Left(K0, IIf(Asc(Mid(K0, 2, 1)) > 64, 2, 1)) 'Wandle Strin ab Zeichen Len(K1)+1 in eine Zahl um '(nur in VBA so möglich, Zellenformel "TEIL" erfordert drei Parameter) K2 = Val(Mid(K0, Len(K1) + 1)) 'Wenn letztes Zeichen einen ASCII-Code > 64 hat, dann schreibe es in K3 If Right(K0, 1) > 64 Then K3 = Right(K0, 1) 'Fülle Hilfsspalten (hinter der letzten beschrifteten Kopfzeile) 'Präfix als Großbuchstabe(n) Cells(HEADERROW + idx, LastColumn + 1) = UCase(K1) 'Ziffer Cells(HEADERROW + idx, LastColumn + 2) = K2 'Suffix als Großbuchstabe Cells(HEADERROW + idx, LastColumn + 3) = UCase(K3) Next idx 'Sortiere Zeilen der Spalten A bis Letzte Listenspalte + drei Hilfsspalten 'nach den Inhalten der Hilfsspalten 1, 2 und 3 Columns("A:" & Chr(64 + LastColumn + 3)).Sort _ Key1:=Cells(2, LastColumn + 1), Order1:=xlAscending, _ Key2:=Cells(2, LastColumn + 2), Order2:=xlAscending, _ Key3:=Cells(2, LastColumn + 3), Order3:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 'Lösche Hilfsspalten Columns(Chr(64 + LastColumn + 1) & ":" & Chr(64 + LastColumn + 3)).ClearContents 'Setze Focus auf Zelle "A1" Range("A1").Select '"Aufräumarbeit" Set ws = Nothing Application.ScreenUpdating = True Application.ScreenUpdating = OldUS Application.Calculation = xlCalculationAutomatic Application.Calculation = OldCalc End Sub
Zu beachten ist dabei bitte, dass ich die derzeitig verbundene Zelle wieder getrennt habe, da ich im Programm automatisch das Zeilenende der Überschriftszeile ermittle, um die daraudf folgenden drei Spalten als temporäre Hilfsspalten zu nutzen. Ich bin jedoch sicher, dass Du ggf. das Programmteil so verändern kannst, dass drei beliebige freie Spalten (z.B. X, Y, Z) dazu benutzt werden können.
Die Kommando-Schaltfläche in Deiner Benutzerform habe ich nicht eingebaut.
Die Konstanten kannst Du ggf. auch durch die entsprechnden direktwerte im Programmabschnitt ersetzen.
https://www.herber.de/bbs/user/37036.xls
Gruß,
Uwe

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread