Sub Excel_SortSpalten2()
'<<< A N P A S S E N >>>
'erste Zeile mit Werten
Const cZ_ERSTEWERTEZEILE = 2
'SpaltenNr. der Spalte,
'aus der die letzte Zeile bestimmt werden soll
'(muß also einen Wert in der letzten Zeile haben)
Const cSP_LETZE_ZEILE_AUS_SPALTE = 1
'Array der Spalten, nach denen sortiert werden soll
'mindestens 1, nach oben keine Grenze
'Reihenfolge nach Priorität, höchste Priorität am Anfang
'als 2. Parameter ist aufsteigend oder absteigend anzugeben
Const cAUF As String = aufsteigend
Const cAB As String = absteigend
Dim SortierSpalten As Variant
SortierSpalten = Array(6, cAUF, 3, cAB, _
2, cAUF, 5, cAUF, _
4, cAUF, 7, cAUF)
'<<< A N P A S S E N E N D E >>>
Dim lRows As Long, lCols As Long, x As Long, y As Long, sp As Long, lSortRichtung As Long
Dim bOK As Boolean
Dim s As String, sTxt As String, sAufAbSteigend As String
Dim ws As Worksheet, r As Range
Set ws = ActiveSheet
'letzte Zeile des zu sortierenden Bereiches feststellen
lRows = ws.Cells(ws.Rows.Count, cSP_LETZE_ZEILE_AUS_SPALTE).End(xlUp).Row
'kann nicht sortiert werden ?
If cZ_ERSTEWERTEZEILE = lRows Then GoTo AUFRAEUMEN
'letzet Spalte des zu sortierenden Bereiches feststellen
lCols = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1
'zu sortierenden Range festlegen
Set r = ws.Range(ws.Cells(cZ_ERSTEWERTEZEILE, 1), ws.Cells(lRows, lCols))
'nacheinander nach den Spalten sortieren
'Reihenfolge: niedrige Priorität -> hoher Priorität
For x = UBound(SortierSpalten) To LBound(SortierSpalten) Step -2
sTxt = SortierSpalten(x - 1)
sAufAbSteigend = SortierSpalten(x)
If ((sAufAbSteigend = cAB) Or (sAufAbSteigend = cAUF)) Then
->Sortierrichtung
If (sAufAbSteigend = cAUF) Then
lSortRichtung = xlAscending
Else
lSortRichtung = xlDescending
End If
->Spaltenangabe auf Zulässigkeit prüfen
bOK = True
If Len(sTxt) = 0 Then
bOK = False
Else
For y = 1 To Len(sTxt)
s = Mid(sTxt, y, 1)
Select Case s
Case 0 To 9:
Case Else:
bOK = False: Exit For
End Select
Next
End If
If Not bOK Then
MsgBox Spaltenangabe ist keine einfache Zahl & vbLf &-> & sTxt &->
Else
sp = sTxt
If (sp < 1) Or (sp > lCols) Then
MsgBox _
Spaltenangabe außerhalb benutztem Bereich & vbLf &-> & sTxt &->
Else
r.Sort Key1:=ws.Cells(cZ_ERSTEWERTEZEILE, sp), ORDER1:=lSortRichtung, Header:=xlNo
End If
End If
Else
MsgBox _
Angabe Sortierrichtung unzul. & vbLf &-> & sAufAbSteigend &->
End If
Next
AUFRAEUMEN:
Set ws = Nothing: Set r = Nothing
End Sub