Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1316to1320
1316to1320
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Sortierung dreiteiliger Ziffern (1-1-1)

Forumthread: Sortierung dreiteiliger Ziffern (1-1-1)

Sortierung dreiteiliger Ziffern (1-1-1)
06.06.2013 08:32:11
Loewelutz
Liebe Ex(cel)perten,
In meiner zu sortierenden B-Spalte ist der Aufbau der Ziffern dreigeteilt und durch Gedankenstriche getrennt (Beispiele: 1-1-1; 12-3-10 usw.). Der erste und dritte Teil können ein- oder zweistellig sein.
Die Sortierreihenfolge soll in der Reihenfolge der Dreiteilung erfolgen, also erst nach dem Teil vor dem 1. Gedankenstrich, dann nach dem vor dem 2. Gedankenstrich und dann nach dem hinteren Teil.
Das Sortieren habe ich mit folgendem Makro gelöst:
Sub Sortieren()
Range("A12:N100").Select
Selection.Sort Key1:=Range("B12"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveSheet.Range("a12:a100").Rows.EntireRow.AutoFit
Range("B12").Select
End Sub
Allerdings erfolgt die Sortierung nur nach der ersten Ziffer, was zu einer nicht gewünschten Reihenfolge führt (z. B. 12-1-1 vor 6-1-1).
Hat jemand eine zündende Idee, wie ich mein Problem lösen kann?
Danke für Eure Hilfe!
Gruß Lutz

Anzeige

22
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sortierung dreiteiliger Ziffern (1-1-1)
06.06.2013 08:40:52
Klaus
Hallo Lutz,
das würde ich
- auf eine Hilfstabelle auslagern (neues Blatt oder gleich neue Datei)
- dort mit "Text in Spalten / Trennzeichen -" auf drei Spalten ausdehnen,
- diese Spalten mit der üblichen Sortiertfunktion sortieren
- die Ursprungsspalte per Formel =A1&"-"&B1&"-"&C1 wieder herstellen
- über diese Formel "kopieren - Inhalte einfügen" um draus Werte zu machen
- die beiden überflüssigen Spalten löschen
- das ganze zurück ins original kopieren
den ganzen Vorgang machst du einmal per Hand, lässt dabei den Rekorder laufen. Das sollte schon 90% der Lösung ergeben, musst nur noch bereinigen und dynamisieren. Dabei helfen wir dann gerne!
Grüße,
Klaus M.vdT.

Anzeige
AW: Sortierung dreiteiliger Ziffern (1-1-1)
06.06.2013 09:26:17
Klaus
Hallo Lutz,
in deiner Zeile 12 stehen Überschriften, ab Zeile 13 bis unbekannt stehen Inhalte. In Spalte B stehen durchgehend Werte im Format 00-00-00 (wieviele Stellen die jeweils haben ist egal, aber IMMER drei Werte und zwei Bindestriche! Niemals mehr als zwei Bindestriche!).
Fehlerwerte wie #NV und #DIV/0 kommen nicht vor.
Unter diesen Vorraussetzungen sollte folgendes Makro deine Aufgabe lösen:
Sub Macro1()
On Error GoTo hell
Const SpalteDreierIndex As Long = 2
Const ErsteZeile As Long = 12          'Inhalt ab Zeile 12
Dim LastRow As Long
Dim LastCol As Long
Dim r As Range
LastRow = Cells(Rows.Count, SpalteDreierIndex).End(xlUp).Row
'zwei Spalten einfügen
Columns(SpalteDreierIndex).Offset(0, 1).Insert shift:=xlToRight
Columns(SpalteDreierIndex).Offset(0, 1).Insert shift:=xlToRight
'Dreierindex aufteilen auf drei Spalten
Application.DisplayAlerts = False
'Range(Cells(ErsteZeile + 1, SpalteDreierIndex), Cells(LastRow, SpalteDreierIndex)).Select
Range(Cells(ErsteZeile + 1, SpalteDreierIndex), Cells(LastRow, SpalteDreierIndex)). _
TextToColumns _
Destination:=Cells(ErsteZeile + 1, SpalteDreierIndex), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
Application.DisplayAlerts = True
'sortieren nach drei Spalten
LastCol = Cells(ErsteZeile, Columns.Count).End(xlToLeft).Column
With Range(Cells(ErsteZeile + 1, 1), Cells(LastRow, LastCol))
.Sort _
Key1:=Cells(ErsteZeile, SpalteDreierIndex + 0), Order1:=xlAscending, _
Key2:=Cells(ErsteZeile, SpalteDreierIndex + 1), Order1:=xlAscending, _
Key3:=Cells(ErsteZeile, SpalteDreierIndex + 2), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
.EntireRow.AutoFit
End With
'Dreierindex wieder herstellen
For Each r In Range(Cells(ErsteZeile + 1, SpalteDreierIndex), Cells(LastRow, SpalteDreierIndex)) _
r.Value = "'" & r.Value & "-" & r.Offset(0, 1).Value & "-" & r.Offset(0, 2).Value
Next r
'zwei Spalten löschen
Columns(SpalteDreierIndex).Offset(0, 1).Delete
Columns(SpalteDreierIndex).Offset(0, 1).Delete
GoTo heaven
hell:
MsgBox "Fehler!" & vbCrLf & "Fehlernummer: " & Err.Number & _
vbCrLf & "Fehlerbeschreibung: " & Err.Description
heaven:
Application.DisplayAlerts = True
End Sub
Anmerkung: Das "zwei Spalten löschen / einfügen" könnte man auch eleganter lösen, funktioniert aber so wie es ist.
Grüße,
Klaus M.vdT.

Anzeige
AW: Sortierung dreiteiliger Ziffern (1-1-1)
06.06.2013 11:35:15
Loewelutz
Hallo Klaus,
erst einmal tausend Dank nicht nur für Deinen Lösungsansatz sondern auch für Deinen Makrovorschlag!
Die Bedingungen hast Du richtig beschrieben: Zeile 12 = Überschriften; Format Spalte B: 00-00-00; immer 3 Werte und 2 Bindestriche; keine Fehlerwerte.
Durch andere Aufgaben bin ich erst jetzt zum Testen Deines Makros gekommen. Beim Auslösen erhalte ich folgende Fehlermeldung:
Fehler beim Kompilieren: Bekanntes Argument nicht gefunden.
Im Code markiert ist die Zeile: TrailingMinusNumbers:=True
Aufgrund bescheidener VBA-Kenntnisse kann ich den Fehler nicht korrigieren.
Kannst Du mir helfen? Danke!
Ich teste gleich noch den Vorschlag von Tino incl. Deiner Korrekturanmerkungen :-)
Viele Grüße
Lutz

Anzeige
xl2003 ....
06.06.2013 11:38:52
Klaus
Hallo Lutz,
in xl2010 funktioniert diese Codezeile! 2003 hab ich grad nicht zum testen an der Hand.
Mach mal bitte folgendes:
- schalte den Makrorekorder an
- markiere B13:B100 (deine Dreier-Werte)
- Clicke auf "Daten - Text in Spalten" und gebe dort "-" als Trennzeichen an
- schalte den Rekorder wieder ab
- poste mir hier den entstandenen Rekordercode!
Dann kann ich das Makro so umschreiben, dass es auch in 2003 funktionert.
Grüße,
Klaus M.vdT.

Anzeige
schuss ins Blaue AW: xl2003 ....
06.06.2013 11:42:46
Klaus
Hallo Lutz,
ich habe aus dem 2010er Text-zu-Spalten mal alles unnötige herausgenommen. Bei mir (2010) klappt es auch ohne den Trailing-Numbers Zusatz.
Anbei nochmal das ganze Makro, mit ein bisschen Glück funktioniert das bereits in 2003!
Wenn nicht: siehe oben (rekordercode usw).
Option Explicit
Sub Macro1()
On Error GoTo hell
Const SpalteDreierIndex As Long = 2
Const ErsteZeile As Long = 12          'Inhalt ab Zeile 12
Dim LastRow As Long
Dim LastCol As Long
Dim r As Range
LastRow = Cells(Rows.Count, SpalteDreierIndex).End(xlUp).Row
'zwei Spalten löschen
Columns(SpalteDreierIndex).Offset(0, 1).Insert shift:=xlToRight
Columns(SpalteDreierIndex).Offset(0, 1).Insert shift:=xlToRight
'Dreierindex aufteilen auf drei Spalten
Application.DisplayAlerts = False
'Range(Cells(ErsteZeile + 1, SpalteDreierIndex), Cells(LastRow, SpalteDreierIndex)).Select
Range(Cells(ErsteZeile + 1, SpalteDreierIndex), Cells(LastRow, SpalteDreierIndex)). _
TextToColumns _
Destination:=Cells(ErsteZeile + 1, SpalteDreierIndex), Other:=True, OtherChar:="-",  _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1))
Application.DisplayAlerts = True
'sortieren nach drei Spalten
LastCol = Cells(ErsteZeile, Columns.Count).End(xlToLeft).Column
With Range(Cells(ErsteZeile + 1, 1), Cells(LastRow, LastCol))
.Sort _
Key1:=Cells(ErsteZeile, SpalteDreierIndex + 0), Order1:=xlAscending, _
Key2:=Cells(ErsteZeile, SpalteDreierIndex + 1), Order1:=xlAscending, _
Key3:=Cells(ErsteZeile, SpalteDreierIndex + 2), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
.EntireRow.AutoFit
End With
'Dreierindex wieder herstellen
For Each r In Range(Cells(ErsteZeile + 1, SpalteDreierIndex), Cells(LastRow, SpalteDreierIndex)) _
r.Value = "'" & r.Value & "-" & r.Offset(0, 1).Value & "-" & r.Offset(0, 2).Value
Next r
'zwei Spalten löschen
Columns(SpalteDreierIndex).Offset(0, 1).Delete
Columns(SpalteDreierIndex).Offset(0, 1).Delete
GoTo heaven
hell:
MsgBox "Fehler!" & vbCrLf & "Fehlernummer: " & Err.Number & _
vbCrLf & "Fehlerbeschreibung: " & Err.Description
heaven:
Application.DisplayAlerts = True
End Sub

Anzeige
AW: Sortierung dreiteiliger Ziffern (1-1-1)
06.06.2013 09:50:04
Tino
Hallo,
kannst mal diesen Code testen.
Im Code gehe ich davon aus, dass in Zeile 1 eine Überschrift ist!
Dieser Code benötigt 3 freie Spalten in der Tabelle!
Sub Sort_Spezial()
Dim iCalc%
On Error GoTo ErrorHandler:
With Application
iCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
'Tabelle anpassen
With Tabelle1
'in Zeile ist die Überschrift, daher ab A2 sonst A1
With .Range("A2", .UsedRange.Rows(.UsedRange.Rows.Count))
.Columns(2).TextToColumns _
Destination:=.Cells(1, .Columns(.Columns.Count).Column + 1), _
DataType:=xlDelimited, Other:=True, OtherChar:="-", _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
End With
'Sortieren gesamten Bereich, in Zeile 1 ist die Überschrift sonst Header:=xlNo
With .Range("A1", .UsedRange.Rows(.UsedRange.Rows.Count))
.Sort Key1:=.Cells(1, .Columns.Count - 2), Order1:=xlAscending, _
Key2:=.Cells(1, .Columns.Count - 1), Order2:=xlAscending, _
Key3:=.Cells(1, .Columns.Count), Order3:=xlAscending, _
Header:=xlYes
.Columns(.Columns.Count - 2).Resize(, 3).EntireColumn.Delete
End With
End With
ErrorHandler:
.Calculation = iCalc
.ScreenUpdating = True
.EnableEvents = True
End With
If Err.Number  0 Then
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub
Gruß Tino

Anzeige
Aufgabe gelesen, Tino?
06.06.2013 10:15:53
Klaus
Hallo Tino,
die Aufgabe beginnt in Zeile 12, nicht in Zeile 1!
Das siehst du hier:
Range("A12:N100").Select
benötigte Leerspalten kann man per Code einfügen, oder einmal per Hand einfügen und dann ausblenden - das tut sich nichts.
Ich bin ein großer Fan davon, Code variabel zu schreiben. Die Anfangszeile einfach nach oben in ein CONST auslagern statt sie innerhalb des Codes wiederholt fix anzugeben macht die Codepflege viel leichter und den Code viel übersichtlicher.
So, genug gestichelt :-)
Grüße,
Klaus M.vdT.

Anzeige
AW: Aufgabe gelesen, Tino?
06.06.2013 10:38:35
Tino
Hallo,
wenn keine Spalten übrig sind aus welchem Grund auch immer, kann man auch keine Hinzufügen. ;-)
Zum anderen,
hat jeder seinen eigenen Stil ich arbeiten in meinen Projekten meist mit Namen in der Tabelle.
In solch einer Miniaufgabe halte ich es für unnötig, Kommentare stehen im Code (2 Anpassungen)
Gruß Tino

Anzeige
AW: Aufgabe gelesen, Tino?
06.06.2013 10:47:41
Klaus
Hallo Tino,
naja ... die Verwendung von "Zeile 1" hast du im Code eben nicht kommentiert, und es gibt insgesamt 6 unterschiedliche Orte, an denen der TE Zeile 1 auf Zeile 12 ändern müsste ... noch dazu stehen die Zeilenangaben mal im RANGE, mal im CELLS Format.
Ehrlich, meinst du wirklich jemand der nach einer solchen Kleinigkeit fragt wie hier und noch dazu einen Codefetzen mit SELECT (offensichtlich Rekordercode) postet, ist in der Lage deinen Code dahingehend zu analysieren und diese Anpassungen selbstständig vorzunehmen? Und wirklich JEDE Referenz, innerhalb der verschachtelten Data-To-Columns und Sort Anweisungen zu finden? Bei "VBA-Bescheiden"?
Das dein Code, wenn auch nur eine Zeilenangabe anzupassen vergessen wird, die gesamte Tabelle zerschießt ist dir klar und egal?
Auf die Notwendigkeit der späteren Code Anpassung, falls mal mehr dazukommt und der Tabellenaufbau sich ändert, will ich gar nicht eingehen, da wirds religiös.
Mit dem Spalten-Einfügen muss ich dir aus akademischer Sicht recht geben, vor allem da xl2003 angegeben ist und so nur 256 Spalten zur Verfügung stehen. Praktisch halte ich es aber für höchst unwarscheinlich, dass dies einen Fehler proviziert.
Grüße,
Klaus M.vdT.

Anzeige
AW: Aufgabe gelesen, Tino?
06.06.2013 11:15:46
Tino
Hallo,
weis ja nicht was bei dir testen bedeutet?!
Stellen wir den Code einfach auf Zeile 12 um (Zeile 11 hat eine Überschrift)
Sub Sort_Spezial()
Dim iCalc%
On Error GoTo ErrorHandler:
With Application
iCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
'Tabelle anpassen
With Tabelle1
'in Zeile 11 ist die Überschrift, daher ab A12 sonst A11
With .Range("A12", .UsedRange.Rows(.UsedRange.Rows.Count))
.Columns(2).TextToColumns _
Destination:=.Cells(1, .Columns(.Columns.Count).Column + 1), _
DataType:=xlDelimited, Other:=True, OtherChar:="-", _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
End With
'Sortieren gesamten Bereich, in Zeile 11 ist die Überschrift sonst Header:=xlNo
With .Range("A11", .UsedRange.Rows(.UsedRange.Rows.Count))
.Sort Key1:=.Cells(1, .Columns.Count - 2), Order1:=xlAscending, _
Key2:=.Cells(1, .Columns.Count - 1), Order2:=xlAscending, _
Key3:=.Cells(1, .Columns.Count), Order3:=xlAscending, _
Header:=xlYes
.Columns(.Columns.Count - 2).Resize(, 3).EntireColumn.Delete
End With
End With
ErrorHandler:
.Calculation = iCalc
.ScreenUpdating = True
.EnableEvents = True
End With
If Err.Number  0 Then
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub
Gruß Tino

Anzeige
Q.E.D.
06.06.2013 11:22:08
Klaus
Hallo Tino,
QED.
        'Sortieren gesamten Bereich, in Zeile 11 ist die Überschrift sonst Header:=xlNo
With .Range("A11", .UsedRange.Rows(.UsedRange.Rows.Count))
.Sort Key1:=.Cells(1 HIER, .Columns.Count - 2), Order1:=xlAscending, _
Key2:=.Cells(1 HIER, .Columns.Count - 1), Order2:=xlAscending, _
Key3:=.Cells(1 HIER, .Columns.Count), Order3:=xlAscending, _
Header:=xlYes

Hättest du den Code von Anfang an auf Zeile 12 lauffähig gepostet hätte ich nichts gesagt, aber das ist genau das was ich meinte!
Grüße,
Klaus M.vdT.

Anzeige
+1 für dich! AW: Q.E.D.
06.06.2013 11:48:23
Klaus
Hallo Tino,
Code läuft wie von dir gepostet, +1 für dich!
(Warum ich auf G1 referenzieren darf, wenn ich ab G12 sortiere, muss mir aber jemand erklären!)
Wie bereits gesagt, hättest du den Code gleich im ersten Post auf Zeile 12 angepasst hätt ich auch nicht gemeckert.
Übrigens: Die Idee, einfach rechts drei Spalten zu benutzen, hatte ich gar nicht erst. Das ist natürlich viel besser als meine "einfügen-Löschen" Lösung, da die Gefahr von Bezug-Fehlern nicht mehr gegeben ist.
Grüße,
Klaus M.vdT.

Anzeige
+1 für dich! AW: Q.E.D.
06.06.2013 11:52:12
Tino
Hallo,
die 1 bezieht sich auf die erste Zeile in dem Range von der With Anweisung.
Gruß Tino

Danke für die Erklärung! owT.
06.06.2013 11:59:34
Klaus
.

angepasst auf Zeile 12 ist Überschrift u. xl2003
06.06.2013 11:48:40
Tino
Hallo,
erst jetzt gelesen.
Nun angepasst auf Zeile 12 ist Überschrift.
https://www.herber.de/bbs/user/85679.xls
Gruß Tino

Anzeige
AW: Aufgabe gelesen, Tino?
06.06.2013 12:03:47
Loewelutz
Hallo Tino,
auch Dir herzlichen Dank für Hilfe!!!
Bei Deinem Code erhalte ich die Fehlermeldung: Anwendungs- oder objektdefinierter Fehler.
Zur Überprüfungsmöglichkeit meine Datei mit Musterdaten
https://www.herber.de/bbs/user/85680.xls
Wäre super nett, wenn Du Dir den Stand mal anschauen könntest! Enthalten ist mein Ursprungcode, der von Klaus und zum Schluss Dein Vorschlag.
Vielen Dank im Voraus
Lutz

Anzeige
siehe Oben
06.06.2013 12:24:51
Klaus
Hallo Lutz,
beide Makros funktionieren in deiner Musterdatei unter xl2010.
siehe mein Beitrag weiter oben.
Grüße,
Klaus M.vdT.

hier Deine Datei...
06.06.2013 12:34:27
Tino
Hallo,
habe den Code diesmal unter xl2003 getestet.
https://www.herber.de/bbs/user/85684.xls
Gruß Tino

Anzeige
neugierig:
06.06.2013 12:39:29
Klaus
Hallo Tino,
ich hab leider keinen Zugriff auf 2003 und finde auf den ersten Blick keinen Codeunterschied. Magst du mir sagen, wo das Kompatibilitätsproblem lag?
Grüßé,
Klaus M.vdT.

AW: neugierig:
06.06.2013 12:48:38
Tino
Hallo,
ich habe keins gehabt, mir kommt der Verdacht hier gehts nicht um xl2003?!
Habe nur die anpassung wegen der Überschrift gemacht die im Beispiel nun doch in 11 ist.
XL2003 habe ich auf VMware ohne andere Versionen die evtl. was beeinflussen könnten.
Gruß Tino

Anzeige
AW: hier Deine Datei...
06.06.2013 13:05:14
Loewelutz
Hallo Tino,
super! Danke für Deine Hilfe, ohne die ich es nicht geschafft hätte.
Dankbare Grüße
Lutz
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige