Excel & VBA

Zum Sortieren der Blätter gibt es verschiedene Möglichkeiten, was auch etwas von den Rahmenbedingungen abhängig ist. Was soll zum Beispiel mit Blättern passieren, deren Namen nicht der Syntax der zu sortierenden Blattnamen entsprechen? Hier sind drei Beispiele, die ggf. noch angepasst werden müssen.

In dem Fall werden unterwegs (also nicht am Anfang) Blätter mit Namen, die nicht der Syntax entsprechen, nach hinten verschoben - ansonsten wird so lange sortiert, bis die Zahl im folgenden Blattnamen nicht mehr gö�er ist:

Sub BlaetterSortieren() Dim bolSortiert As Boolean Dim intBlatt As Integer, intBlatt1 As Integer Dim varAkt, varNaechst bolSortiert = False Do While bolSortiert = False bolSortiert = True For intBlatt = 1 To Sheets.Count varAkt = Replace(Sheets(intBlatt).Name, "Tab", "") If IsNumeric(varAkt) Then For intBlatt1 = intBlatt To Sheets.Count varNaechst = Replace(Sheets(intBlatt1).Name, "Tab", "") If IsNumeric(varNaechst) Then If varNaechst * 1 < varAkt * 1 Then Sheets(intBlatt1).Move Before:=Sheets(intBlatt) bolSortiert = False End If Else Sheets(intBlatt1).Move after:=Sheets(Sheets.Count) End If Next End If Next Loop End Sub

Ein Beispiel mit Sprungmarken, Reihenfolge Tab1, Tab2, Tab11:

Sub Blattsort() Dim intAnzahl As Integer, intN As Integer, intM As Integer, intI As Integer, intZahlM As Integer, intZahlN As Integer Dim WS As Worksheet intAnzahl = ActiveWorkbook.Worksheets.Count For intM = 1 To intAnzahl For intN = intM To intAnzahl On Error Resume Next For intI = 1 To Len(Worksheets(intN).Name) If IsNumeric(Right(Worksheets(intN).Name, intI)) = False Then intI = intI - 1 If intI = 0 Then GoTo TEXT intZahlN = Right(Worksheets(intN).Name, intI) Exit For End If Next intI For intI = 1 To Len(Worksheets(intM).Name) If IsNumeric(Right(Worksheets(intM).Name, intI)) = False Then intI = intI - 1 If intI = 0 Then GoTo TEXT intZahlM = Right(Worksheets(intM).Name, intI) Exit For End If Next intI If CInt(intZahlN) < CInt(intZahlM) Then Worksheets(intN).Move Before:=Worksheets(intM) GoTo NAECHSTE TEXT: If Worksheets(intN).Name < Worksheets(intM).Name Then Worksheets(intN).Move Before:=Worksheets(intM) NAECHSTE: Next intN Next intM MsgBox "Anzahl der Tabellen: " & intAnzahl End Sub

Ein kurzes Beispiel, aber die Reihenfolge ist Tab1, Tab11, Tab2:

Sub Blattsort1() Dim intX As Integer Dim bolY As Boolean Do bolY = True For intX = 1 To Sheets.Count - 1 If Sheets(intX).Name > Sheets(intX + 1).Name Then Sheets(intX + 1).Move Before:=Sheets(intX) bolY = False End If Next intX Loop Until bolY = True End Sub