kannst mal testen...
05.08.2010 14:50:48
Tino
Hallo,
die Spalte wo die Straßen stehen und die Tabelle müsstest Du im Code anpassen.
Zudem müssen zwei Spalten frei sein für Hilfspalten die am Ende wieder gelöscht werden.
Ist dies nicht möglich, müssen man sich was anderes einfallen lassen.
(Hilfstabelle oder Datei oder Array, kommt auf den Tabellenaufbau an)
Sub Sortiere()
Dim rngRange As Range
Dim oWS As Worksheet
'Spalte anpassen
Const lnrColSortSpalte As Long = 3
'Tabelle anpassen
Set oWS = Sheets("Tabelle1")
With Application
.ScreenUpdating = False
.EnableEvents = False
With oWS
With .UsedRange
With .Columns(.Columns.Count).Offset(0, 1).Resize(, 2)
.Columns(1).FormulaR1C1 = _
"=LOOKUP(9^9,--RIGHT(RC" & lnrColSortSpalte & ",COLUMN(R1)))"
.Columns(2).FormulaR1C1 = _
"=SUBSTITUTE(RC" & lnrColSortSpalte & ",RC[-1],"""")"
End With
End With
With .UsedRange
.Sort _
Key1:=.Cells(2, .Columns.Count), Order1:=xlAscending, _
Key2:=.Cells(2, .Columns.Count - 1), Order2:=xlAscending, Header:=xlYes
oWS.Range(.Columns(.Columns.Count), .Columns(.Columns.Count - 1)).EntireColumn.Delete
End With
End With
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Gruß Tino