Mir stellen sich zwei Fragen:
-
Soll zu bereits vorhandenen Überschriften - nachträglich - weitere Unterpunkte eintragbar sein (ja/nein)?
-
Wie findest du derzeit die Position (Zelle), für eine neue Überschrift / Unterpunkt?
Mein vorheriges Beispiel sollte dir nur veranschaulichen, dass wenn du diese Zelle für Überschrift hast, du ganz einfach auf Unterpunkte testen und neue Überschriften hinzufügen kannst.
Hierzu empfehle ich Hilfsfunktionen zu diesem Zweck zu erstellen, z.B.
Option Explicit
Public Function ErstelleNeueUberschrift(Uberschrift As String) As Excel.Range
With ThisWorkbook.Worksheets("Tabelle1")
' 1) suche in Spalte A nach letzter Zelle mit Inhalt
' -> letzteZelle | z.B Zelle A3
' 2) ermittle Anzahl der Unterpunkte von dieser Überschrift
' -> nAnzahlUnterpkt | z.B 3 Unterpunkte
' 3) erstelle neue Überschrift
' -> Set letzteZelle = letzteZelle.Offset(nAnzahlUnterpkt + 2, 0) | obigen Beispiel folgend: [A3].Offset(3 + 2, 0) => A8
' -> letzteZelle.Value = Überschrift
' Funktionsrückgabe setzen
' Set ErstelleNeueUberschrift = letzteZelle
End With
End Function
Sub Anwendungsbeispiel()
Dim rngU As Excel.Range
Set rngU = ErstelleNeueUberschrift("Überschrift 1")
End Sub
|