Hilfe zu Makro-Gruppieren
21.01.2019 10:31:09
Ursel
Ich benötige bitte Hilfe zu einem Makro.
Habe eine Liste mit zahlreichen Daten (ca. 1500 Zeilen) uns verschiedenen Indizes.
1
1.1
1.1.1
1.1.2
1.1.3
1.1.4
1.1.5
1.1.6
1.1.7
1.1.8
1.2
1.2.1
1.2.2
1.2.3
1.2.4
1.2.5
1.2.6
1.2.7
1.2.11
1.2.12
1.3
1.3.1
1.3.2
1.3.3
1.3.4
1.3.5
1.3.6
1.3.7
25
25.1
25.1.1.
usw.
Der Index steht jeweils in Zelle C10, in Zelle B10 habe ich eine Formel:
=TEXT("00"&C10;"000") - diese dient weiterführend für nachstehendes Makro zum Erstellen von automatischen Gruppierungen.
Es erstellt aufgrund von Textlängen Untergruppen (3 Ebenen: 1, 1.1, 1.1.1 usw., Blatt ist vorher schreibgeschützt und soll es nachher auch wieder sein):
Sub Makro_Gruppieren() 'Makro für automatische Gruppierung
ActiveSheet.Unprotect
Columns("B:B").Select
Selection.Copy
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:A").Select
Selection.ClearOutline
Range("A10").Select
Dim Zelle As Range
For Each Zelle In Columns(1).SpecialCells(xlCellTypeConstants)
If Len(Zelle.Value) >= 5 Then Zelle.EntireRow.Group
Next
For Each Zelle In Columns(1).SpecialCells(xlCellTypeConstants)
If Len(Zelle.Value) >= 7 Then Zelle.EntireRow.Group
Next
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFiltering:=True
End Sub
Mein Problem ist nun, dass immer die letzte Untergruppe der Ebene 3 (zB 1.1.8, 1.2.12, 1.3.7) nicht gruppiert wird. und wenn ich zusätzlich eingebe:For Each Zelle In Columns(1).SpecialCells(xlCellTypeConstants)
If Len(Zelle.Value) Next
dann sind zwar die Untergruppen korrekt, ich kann aber nicht mehr in Ebene 1 gliedern (nur Ebene 2 und 3).
Kann mir jemand helfen?
Gerne schicke ich auch eine Probe-Datei, wo man das Vorgehen sieht.
DANKE schon im Voraus!!!!
Gruß Ursel