hi :-)
bin nun einen anderen weg gegangen ^^
gruss nighty
Sub WksNanenSort()
Call EventsOff
On Error Resume Next
Dim WksIndex As Long
Worksheets.Add after:=Worksheets(Worksheets.Count)
Columns("B:C").NumberFormat = "@"
ActiveSheet.Name = "temp"
For WksIndex = 1 To Worksheets.Count - 1
Cells(WksIndex, 1) = ZahlenBlockIsolierung(Worksheets(WksIndex).Name, 1)
Cells(WksIndex, 2) = ZeichenBlockIsolierung(Worksheets(WksIndex).Name, 1)
Cells(WksIndex, 3) = Worksheets(WksIndex).Name
Cells(WksIndex, 4) = Month("1 " & Cells(WksIndex, 2))
Next WksIndex
Columns("A:D").Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("D1") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
For WksIndex = 1 To Worksheets.Count - 1
Worksheets("" & Worksheets("temp").Cells(WksIndex, 3)).Move after:=Worksheets(WksIndex)
Next WksIndex
Worksheets("temp").Delete
Call EventsOn
End Sub
Function ZahlenBlockIsolierung(Zellen As Variant, ZahlenBlock As Integer) As String
Dim Zelle As Range
Dim Zeichen As Integer
Dim schalter As Boolean
Dim BlockIndex As Integer
ReDim AnzZahlenBlock(Len([Zellen])) As String
BlockIndex = 1
If ZahlenBlock > Len([Zellen]) Then ZahlenBlock = Len([Zellen])
For Zeichen = 1 To Len([Zellen])
If Mid([Zellen], Zeichen, 1) Like "[0-9]" = True Then
AnzZahlenBlock(BlockIndex) = AnzZahlenBlock(BlockIndex) & Mid([Zellen], Zeichen, 1)
schalter = True
End If
If schalter = True And Mid([Zellen], Zeichen, 1) Like "[0-9]" = False Then
BlockIndex = BlockIndex + 1
schalter = False
End If
Next Zeichen
ZahlenBlockIsolierung = AnzZahlenBlock(ZahlenBlock)
End Function
Function ZeichenBlockIsolierung(Zellen As Variant, ZahlenBlock As Integer) As String
Dim Zelle As Range
Dim Zeichen As Integer
Dim schalter As Boolean
Dim BlockIndex As Integer
ReDim AnzZahlenBlock(Len([Zellen])) As String
BlockIndex = 1
If ZahlenBlock > Len([Zellen]) Then ZahlenBlock = Len([Zellen])
For Zeichen = 1 To Len([Zellen])
If Mid([Zellen], Zeichen, 1) Like "[a-z,A-Z,ö,ä,ü,Ö,Ä,Ü]" = True Then
AnzZahlenBlock(BlockIndex) = AnzZahlenBlock(BlockIndex) & Mid([Zellen], Zeichen, 1)
schalter = True
End If
If schalter = True And Mid([Zellen], Zeichen, 1) Like "[a-z,A-Z,ö,ä,ü,Ö,Ä,Ü]" = False Then
BlockIndex = BlockIndex + 1
schalter = False
End If
Next Zeichen
ZeichenBlockIsolierung = AnzZahlenBlock(ZahlenBlock)
End Function
Public Sub EventsOff()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
handicap
monatsnamen muessen richtig geschrieben sein,da ich ueber month auf den jeweiligen index zurueckgreife
