title image


Smiley Re: Tabellenblätter alphabetisch sortieren
Hi,



da habe ich mir einmal eine Sammlung mit vd Optionen zusammengesammelt :-)



Grüße

Paul



---schnipp---



Sub SheetSortName()

Dim x As Integer, y As Integer, wsCount As Integer

wsCount = ActiveWorkbook.Worksheets.Count

For x = 1 To wsCount

For y = x To wsCount

If UCase(Worksheets(y).Name) < UCase(Worksheets(x).Name) Then

Worksheets(y).Move Before:=Worksheets(x)

End If

Next y

Next x

End Sub



Sub SheetSortNumber()

Dim x As Integer, y As Integer, wsCount As Integer, Blatt As Worksheet

wsCount = ActiveWorkbook.Worksheets.Count

If ActiveWorkbook Is Nothing Then Exit Sub

Application.ScreenUpdating = False

'Überprüfung der Blattnamen

For Each Blatt In ActiveWorkbook.Sheets

If Not Blatt.Name Like "Tabelle*" Then

MsgBox ("Blattnamen müssen alle mit 'Tabelle' beginnen")

Blatt.Activate

Exit Sub

End If

Next Blatt

For x = 1 To wsCount

For y = x To wsCount

If Val(Right(Worksheets(y).Name, Len(Worksheets(y).Name) - 7)) _

< Val(Right(Worksheets(x).Name, Len(Worksheets(x).Name) - 7)) Then

Worksheets(y).Move Before:=Worksheets(x)

End If

Next y

Next x

Application.ScreenUpdating = True

End Sub



Sub SheetSortColor()

Dim x As Integer, y As Integer, wsCount As Integer

wsCount = ActiveWorkbook.Worksheets.Count

For x = 1 To wsCount

For y = x To wsCount

If Worksheets(y).Tab.Color < Worksheets(x).Tab.Color Then

Worksheets(y).Move Before:=Worksheets(x)

End If

Next y

Next x

End Sub



Sub markierte_Sortieren()

' nur markierte Tabellen sortieren

' dazu Sort Z_A und Sort A_Z

Dim WsW As Worksheet

Dim WsX As Worksheet

Dim Register() As String

Dim Loi As Long

Set WsW = ActiveSheet

' markierte Tabellen in Array schreiben

For Each WsX In ActiveWorkbook.Windows(1).SelectedSheets

ReDim Preserve Register(0 To Loi)

Register(Loi) = WsX.Name

Loi = Loi + 1

Next WsX

' Array sortieren

Sort_Z_A Register, LBound(Register), UBound(Register)

' Tabellen nach Array anordnen

For Loi = UBound(Register) - 1 To 0 Step -1

Worksheets(Register(Loi)).Move Before:=Worksheets(Register(Loi + 1))

Next Loi

WsW.Activate

Set WsW = Nothing

End Sub



Public Sub Sort_Z_A(SortArray, L, R)

' sortieren von Z bis A

' zu markierte sortieren

Dim i, J, x, y

i = L

J = R

x = SortArray((L + R) / 2)

While (i <= J)

While (SortArray(i) < x And i < R)

i = i + 1

Wend

While (x L)

J = J - 1

Wend

If (i <= J) Then

y = SortArray(i)

SortArray(i) = SortArray(J)

SortArray(J) = y

i = i + 1

J = J - 1

End If

Wend

If (L < J) Then Call Sort_Z_A(SortArray, L, J)

If (i < R) Then Call Sort_Z_A(SortArray, i, R)

End Sub



Public Sub Sort_A_Z(SortArray, L, R)

' sortieren von A bis Z

' zu markierte sortieren

Dim i, J, x, y

i = L

J = R

x = SortArray((L + R) / 2)

While (i <= J)

While (SortArray(i) > x And i < R)

i = i + 1

Wend

While (x > SortArray(J) And J > L)

J = J - 1

Wend

If (i <= J) Then

y = SortArray(i)

SortArray(i) = SortArray(J)

SortArray(J) = y

i = i + 1

J = J - 1

End If

Wend

If (L < J) Then Call Sort_A_Z(SortArray, L, J)

If (i < R) Then Call Sort_A_Z(SortArray, i, R)

End Sub



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: