Automatische Aufzählungszeichen mit Einzug

Guten Tag Hansi!

Um diese Frage abschließen zu können, würde ich gerne von Ihnen wissen, ob die genannte Lösung für Sie hilfreich war und Sie diese akzeptieren können?

Falls weitere Fragen sein sollten, stehe ich Ihnen weiterhin gerne zur Verfügung!

Über eine mögliche Bewertung würde ich mich ebenfalls sehr freuen!

MfG

Super danke. Habe es noch um eine zusätzliche Ebene erweitert.

Vielen Dank für all eure Hilfe!

lg

Hansi

Nachtrag:

Noch ein kurzer Hinweis, damit nicht versehentlich Daten überschrieben werden.

In Spalte B werden die Level der Einrückung ausgelesen.

Siehe hierzu

aktIndent = Range("B" & cl.Row).IndentLevel ' Setzen der aktuellen Einrückung ab Zeile 2

In Spalte A werden die Listennummerierungen eingetragen.

Siehe hierzu:

Cells(cl.Row, 1).Value = listenEintrag ' Eintrag der Listennummerierung in Spalte A[cl.row]

MfG

Guten Morgen!

Gerade habe ich nochmals ein wenig programmiert um eine "saubere" Lösung zu finden.

In meiner jetzigen Lösung bin ich auf die Einrückungslevel eingegangen.

Ausggangen wird von den Einrückungen in Spalte B (siehe aktIndent)

Die Lösung geht davon aus, dass die erste Zeile im lvl 0 steht.

Die folgenden Einrückungen orientieren sich an dem letzten Einrückungslevel.

Weiterhin geht der Code davon aus, dass max 1 Level pro Einrückung steigt.

Jedoch kann das Einrückungslevel um mehrere Level sinken.

Der Code ist bei mir getestet und funktionierte.

Sub Einrueckung(r As Range)

Dim lastIndent, aktIndent, aktLvlCnt, indentDif As Integer ' Vorletzter und letzter Indent
Dim lstIndentStartRange As String
Dim listenEintrag As String ' Wert der Einrückung

lastIndent = -1 ' Startwert fuer die erste Zeile

For Each cl In r
If lastIndent = -1 Then ' Setzen des lastIndent der ersten Zeile
lastIndent = 0
aktIndent = 0
aktLvlCnt = 1
listenEintrag = aktLvlCnt
Else

aktIndent = Range("B" & cl.Row).IndentLevel ' Setzen der aktuellen Einrückung ab Zeile 2
If lastIndent = aktIndent Then ' Das level hat sich nicht geaendert
aktLvlCnt = aktLvlCnt + 1
listenEintrag = Left(listenEintrag, Len(listenEintrag) - 1) & aktLvlCnt

ElseIf aktIndent > lastIndent Then ' Level aufstieg
aktLvlCnt = 1 ' Rücksetzung des LevelCounters auf 1
lastIndent = aktIndent ' Setzen des neuen lvl
listenEintrag = Left(listenEintrag, Len(listenEintrag)) & "." & aktLvlCnt

ElseIf aktIndent < lastIndent Then ' LevelAbstieg
aktLvlCnt = Mid(listenEintrag, (aktIndent * 2) + 1, 1) + 1
If aktIndent = 0 Then
listenEintrag = aktLvlCnt ' in Ebene 0 neuer Eintrag
Else
indentDif = (lastIndent - aktIndent) * 2 ' Zeichen die aufgrund des Levelabstiegs zu emtfernen sind
listenEintrag = Left(listenEintrag, indentDif) & aktLvlCnt
End If
lastIndent = aktIndent ' Reset des lvl

End If

End If

Cells(cl.Row, 1).Value = listenEintrag ' Eintrag der Listennummerierung in Spalte A[cl.row]

Next cl

End Sub

Dies sollte nun das gewünschte Ergebnis sein.

Falls Fragen sein sollten, stehe ich gerne zur Verfügung!

MfG

Hallo Claus.

danke für das Makro.

Ich habe es mir angesehen aber nicht ganz verstanden.

Ich möchte in der Spalte B den Einzug auslesen und dann in Spalte A den richtigen Wert setzen. Abhängig von der darüberliegenden Zeile

Also wenn in B5 zb. der Einzug bei 1 steht und in B4 bereits 1.1 enthalten ist, sollte in B5 dann 1.2 erscheinen.

das wäre das Ergebnis.

[table][tr][td]Nummer[/td][td]Projekte[/td][td]Soll[/td][/tr][tr][td]1.[/td][td]Aufgabe A[/td][td]1[/td][/tr][tr][td]1.1.[/td][td] Aufgabe A.1[/td][td]1.1[/td][/tr][tr][td]1.2.[/td][td] Aufgabe A.2[/td][td]1.2[/td][/tr][tr][td]2.[/td][td]Aufgabe B[/td][td]2[/td][/tr][tr][td]2.1.[/td][td] Aufgabe B.1[/td][td]2.1[/td][/tr][tr][td]2.2.[/td][td] Aufgabe B.1.1[/td][td]2.1.1[/td][/tr][tr][td]3.[/td][td] Aufgabe B.2[/td][td]2.2[/td][/tr][tr][td]3.1.[/td][td][td][/tr][tr][td]3.2.[/td][td][td][/tr][/table]

Die Unterpunkte müssten flexibel sein, daher die Abfrage auf die Einzugsgröße.

Ich denke das wird ein wenig kompliziert

Habe unter SOLL die richtigen Werte hingeschrieben.

Danke für den Einsatz.

lg

Hannes