Hallo
- dann je ein Aufrufmakro für die Bereiche mit Variablenübergabe
- und ein Unterprogramm für beide Fälle
Sub Sortieren_A_bis_D()
Call Sortieren(3, 5)
End Sub
Sub Sortieren_F_bis_F()
Call Sortieren(8, 10)
End Sub
Private Sub Sortieren(SP As Integer, CC As Integer)
Dim LR As Double, ZE As Integer, TB1
ZE = 3 'Werte ab Zeile
With Sheets("Tabelle1")
LR = .Cells(.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
.Columns(CC).Resize(, 3).Insert xlToRight
.Columns(CC).Resize(, 3).NumberFormat = "General"
.Columns(CC).Resize(, 3).ColumnWidth = 10
.Range(.Cells(ZE, CC), .Cells(LR, CC)).FormulaR1C1 = _
"=LEFT(SUBSTITUTE(RC[-2],""-"",""""),1)"
.Range(.Cells(ZE, CC + 1), .Cells(LR, CC + 1)).FormulaR1C1 = _
"=IFERROR(--MID(SUBSTITUTE(RC[-3],""-"",""""),2,FIND(""."",RC[-3])-2),--MID(SUBSTITUTE(RC[-3],""-"",""""),2,99))"
.Range(.Cells(ZE, CC + 2), .Cells(LR, CC + 2)).FormulaR1C1 = _
"=IFERROR(--MID(RC[-4],FIND(""."",RC[-4])+1,99),-1)"
.Range(.Cells(ZE, CC), .Cells(LR, CC + 2)).Value = .Range(.Cells(ZE, CC), .Cells(LR, CC + 2)).Value
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Range(Cells(ZE, CC), Cells(LR, CC)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range(Cells(ZE, CC + 1), Cells(LR, CC + 1)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range(Cells(ZE, CC + 2), Cells(LR, CC + 2)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range(Cells(ZE, SP), Cells(LR, CC + 2))
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
.Columns(CC).Resize(, 3).Delete xlToLeft
End With
End Sub
LG UweD