Autor: Peter Haserodt  --- Aus Excel VBA - Gruppe: Häufige Fragen

Blattsortierung in der Arbeitsmappe

Autor: Peter Haserodt - Erstellt: --      - Letzte Revision: --
Blätter (Tabellen) sortieren ist immer mal erwünscht.

Hier der Code, der innerhalb des Codes näher erläutert wird.
Die Funktion Quicksort wurde an anderer Stelle schon vorgestellt.

Option Explicit
Public Sub BlattSortierung()
Dim vX() As String, i As Integer
' Peter Haserodt 2004
'Nimmt hier das aktive Workbook und setzt voraus das nichts geschützt ist.
'Muss sonst angepasst werden
' Sortiert alle Blätter also auch z.B. Diagramme
On Error GoTo Fehler
With ActiveWorkbook
 ReDim vX(.Sheets.Count) ' Das Feld auf die Blattanzahl dimensionieren
 If .Sheets.Count = 1 Then Exit Sub ' Dann muss nicht sortiert werden
 For i = 1 To .Sheets.Count ' Das Feld mit den Blattnamen füllen
  vX(i) = .Sheets(i).Name
 Next i
 QuickSort_Feld vX, 1, .Sheets.Count, False ' Jetzt aufsteigend sortieren
 .Sheets(vX(1)).Move Before:=.Sheets(1) ' Das erste Blatt nach vorne
 For i = 2 To .Sheets.Count ' und jetzt die anderen
  .Sheets(vX(i)).Move After:=.Sheets(i - 1)
 Next i
End With
Exit Sub
Fehler:
MsgBox Err.Description
End Sub
Private Sub QuickSort_Feld(DasFeld, StartUnten, _
 EndeOben, Absteigend As Boolean)
'QuickSort Standard
Dim iUnten As Long, iOben, iMitte, y
iUnten = StartUnten
iOben = EndeOben
iMitte = DasFeld((StartUnten + EndeOben) / 2)
While (iUnten <= iOben)
 If Not Absteigend Then
  While (DasFeld(iUnten) < iMitte And iUnten < EndeOben)
   iUnten = iUnten + 1
  Wend
  While (iMitte < DasFeld(iOben) And iOben > StartUnten)
   iOben = iOben - 1
  Wend
 Else
  While (DasFeld(iUnten) > iMitte And iUnten < EndeOben)
   iUnten = iUnten + 1
  Wend
  While (iMitte > DasFeld(iOben) And iOben > StartUnten)
   iOben = iOben - 1
  Wend
 End If
 If (iUnten <= iOben) Then
  y = DasFeld(iUnten)
  DasFeld(iUnten) = DasFeld(iOben)
  DasFeld(iOben) = y
  iUnten = iUnten + 1
  iOben = iOben - 1
 End If
Wend
If (StartUnten < iOben) Then Call QuickSort_Feld(DasFeld, _
 StartUnten, iOben, Absteigend)
 If (iUnten < EndeOben) Then Call QuickSort_Feld(DasFeld, _
 iUnten, EndeOben, Absteigend)
End Sub

Weitere Artikel der Gruppe: Häufige Fragen Aus Excel VBA
Nach oben
ToDo
Google Werbung