Blattsortierung klappt nicht

Forumthread: Blattsortierung klappt nicht

Andre

Hallo Ihr lieben Leute,
ich bin heute das erste Mal hier und hoffe, dass mir vielleicht geholfen wird. Ich habe eine Exceltabelle,
in der die Blätter mit 1.KW, 2. KW, usw. benannt werden sollen. Das klappt soweit ganz gut.
Nur sollen die Tabellenblätter auch sortiert werden. Wenn man also die 4. KW erstellt, nach der 7. KW, dann wird sie auch davor einsortiert. Nur erstellt man zum Beispiel die 31. KW, dann wird sie hinter der 3. KW einsortiert und nicht hinter der 7. KW.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Blattsortierung klappt nicht

24.12.2009 13:36:11

Andre

Oh. entschuldigt.
Bielen Dank für Eure Mühen und schöne Tage wünsche ich allen hier.
Gruß Andre

AW: Blattsortierung klappt nicht

24.12.2009 14:35:27

Peter

Hallo Andre,
so sollte das funktionieren:

Sub Tabellenblaetter_Sortieren_II()
'   wenn anstatt "Worksheets" nur "Sheets"
'   genommen wird, werden Diagramme usw. mitsortiert
Dim i  As Integer
Dim y  As Integer
For i = 1 To Worksheets.Count
For y = Worksheets.Count To 2 Step -1
If Worksheets(y).Name

Gruß und frohe Weihnachten
Peter

Blattsortierung und Neueanlage-Position

25.12.2009 14:00:34

Erich

Hi Andre,
zum Anlegen eines neuen Blattes könntest du das hier probieren:


Sub testAnlegen()
Tabellenblatt_Anlegen 33 ' KW, für die das Blatt angelegt werden soll
End Sub
Sub Tabellenblatt_Anlegen(intKW As Integer)
Dim ii As Integer, jj As Integer, strN As String
ReDim arrN(1 To Worksheets.Count)
For ii = 1 To Worksheets.Count
arrN(ii) = 99
jj = InStr(Worksheets(ii).Name, ".") - 1
If jj > 0 Then
If IsNumeric(Left$(Worksheets(ii).Name, jj)) Then _
arrN(ii) = CInt(Left$(Worksheets(ii).Name, jj)) ' Nummern der alten Blätter
End If
Next ii
strN = CStr(intKW) & ". KW"                              ' Name des neuen Blatts
For ii = 1 To Worksheets.Count
Select Case arrN(ii)
Case Is = intKW
MsgBox "Blatt " & strN & " existiert bereits."     ' keine Anlage - doppelt
Exit Sub
Case Is > intKW
Worksheets.Add(before:=Worksheets(ii)).Name = strN ' Anlage
Exit Sub
End Select
Next ii
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = strN ' neues letztes Blatt
End Sub

Das setzt natürlich voraus, dass die vorher bereits existierenden Blätter sortiert sind.
Erreichen kannst du den Sort hiermit:


Sub Tabellenblaetter_Sortieren_3()
' wenn anstatt "Worksheets" nur "Sheets" genommen wird,
' werden Diagramme usw. mitsortiert
Dim ii As Integer, jj As Integer, mm As Integer, arrN() As Integer
ReDim arrN(1 To Worksheets.Count)
For ii = 1 To Worksheets.Count
arrN(ii) = 99
jj = InStr(Worksheets(ii).Name, ".") - 1
If jj > 0 Then
If IsNumeric(Left$(Worksheets(ii).Name, jj)) Then _
arrN(ii) = CInt(Left$(Worksheets(ii).Name, jj))  ' Nummern der Blätter
End If
Next ii
For ii = 1 To Worksheets.Count - 1
For jj = ii + 1 To Worksheets.Count
If arrN(jj)

Das Problem hättest du nicht, wenn du die Blätter "01. KW" usw. nennen würdest - mit immer 2 Stellen für die Woche.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Blattsortierung korrigiert

28.12.2009 17:50:43

Erich

Hi Andre,
bei der Blattsortierung traue ich meinem Code nicht über den Weg (ohne genauer getestet zu haben).
Die richtige Neuanlage sollte funzen wie gehabt.
Probier mal den Sort mit


Sub Tabellenblaetter_Sortieren_4()
' wenn anstatt "Worksheets" nur "Sheets" genommen wird,
' werden Diagramme usw. mitsortiert
Dim intB As Long, ii As Long, jj As Long, mm As Long, arrN()
intB = Worksheets.Count
ReDim arrN(1 To intB, 1)
For ii = 1 To intB
arrN(ii, 1) = Worksheets(ii).Name                  ' Namen   der Blätter
arrN(ii, 0) = 99
jj = InStr(Worksheets(ii).Name, ".") - 1
If jj > 0 Then
If IsNumeric(Left$(Worksheets(ii).Name, jj)) Then _
arrN(ii, 0) = CInt(Left$(Worksheets(ii).Name, jj)) ' Nummern der Blätter
End If
Next ii
BubbleSort_01 arrN()
For ii = 1 To intB - 1
If Worksheets(arrN(ii, 1)).Index > ii Then _
Worksheets(arrN(ii, 1)).Move before:=Worksheets(ii)
Next ii
End Sub
Sub BubbleSort_01(ByRef arrVar())                           ' BubbleSort
Dim OG As Long, i As Long, h0, h1
OG = UBound(arrVar, 1)
Do
For i = 1 To OG - 1
If arrVar(i, 0) > arrVar(i + 1, 0) Then
h0 = arrVar(i, 0)
h1 = arrVar(i, 1)
arrVar(i, 0) = arrVar(i + 1, 0)
arrVar(i, 1) = arrVar(i + 1, 1)
arrVar(i + 1, 0) = h0
arrVar(i + 1, 1) = h1
End If
Next i
OG = OG - 1
Loop While OG > 1
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

Forumthread: Blattsortierung klappt nicht

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread