Excel: Sortieren nach 5 Schlüsseln

Sub Excel_SortSpalten()

'<<< 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
Dim SortierSpalten As Variant
SortierSpalten = Array(6, 3, 2, 5, 4, 7)

'<<< 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
Dim bOK As Boolean
Dim s As String, sTxt 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 -1
 
 sTxt = SortierSpalten(x)
->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:=xlAscending, Header:=xlNo
  End If
 End If
Next

AUFRAEUMEN:
 Set ws = Nothing: Set r = Nothing
End Sub

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