Nummerierung nach Leveln

Hallo liebes Forum,
ich habe mich hier einmal angemeldet auf der Suche nach Hilfe.
Ich habe ein recht umfangreiches Excel Sheet für ein Geschäftsprozessmodell. Ich möchte dort in der ersten Spalte eine Nummerierung durchführen, welche gleichzeitig die ID einer Zeile wird.
Letztendlich möchte ich eine ähnliche Nummerierung in Leveln wie z.B. bei Überschriftenlisten wie in Word.
Neues Kapitel z.b. Kapitel 1, Kapitel 2
Neues Unterkapitel (z.B Kapitel 1.1, Kapitel 1.2, Kapitel 1.3)
usw.
Ich habe ein Beispiel angefügt. So wie in der ersten Spalte ID hätte ich gerne die Nummerierung. Diese habe ich hier mal händisch eingefügt. Ich denke aber, hiermit wird klar was ich möchte.
Hat da einer eine Idee.
Userbild

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

hallo
anbei eine Makro Lösung. Bitte in ein Modulblatt kopieren und testen.
In der Anweisung Const Blatt steht "Tabelle", zum testen des Makros.
Bitte hier den Tabellen Namen ihrer Datei eintragen.
LZell = 1000 ist die letzte Zeile in der Tabelle
Wenn es mehr Zeilen sind bitte selbst erhöhen.
Würde mich freuen wenn es einwandfrei kalappt. Hicks.. (Kölle Allaf)
mfg Piet
Option Explicit '10.2.2016 Piet für Herber Forum
Const Blatt = "Tabelle1"
Const LZell = 1000

Sub Nummertierung_nach_Level()
Dim Lnxt, LIndx, L2, L3, L4   'Level Zahl 2-4
Dim Lev1, Lev2, Lev3, Lev4    'Level Text
Dim Edr, Zelle, ID: ID = 1    '1.ID Nummer
'Schleife zum ermitteln der ID Nummer
Edr = Sheets(Blatt).Cells(LZell, "C").End(xlUp).Address
For Each Zelle In Sheets(Blatt).Range("C2", Edr)
'Auswertung ohne Leerzeile ; Exit bei 2x Leerzeile
If Zelle.Value = Empty Then  'ohne Leerzeile
If Zelle.Cells(2, 1) = Empty Then Exit For
ElseIf Zelle.Offset(0, -2) = Empty Then
LIndx = Zelle.Cells(1, 0)        'Level Index
Lnxt = Trim(Zelle.Cells(2, 1))   'next Level
Lev2 = Trim(Zelle.Cells(1, 2))   'Level Text 2-4
Lev3 = Trim(Zelle.Cells(1, 3))
Lev4 = Trim(Zelle.Cells(1, 4))
'Level Zahl 2-4 addieren  ()
If Lev2  Zelle.Cells(0, 2) Then L2 = L2 + 1
If Lev3  Zelle.Cells(0, 3) Then L3 = L3 + 1
If Lev4  Zelle.Cells(0, 4) Then L4 = L4 + 1
'Level Zahl 2-4 löschen  (wenn 0)
If Lev4 = Empty Then L4 = Empty
If Lev3 = Empty Then L3 = Empty: L4 = Empty
If Lev2 = Empty Then L3 = Empty: L4 = Empty: L2 = Empty
'Level Auswertung über Index und einfügen
Select Case LIndx
Case 1:  Zelle.Offset(0, -2) = ID
Case 2:  Zelle.Offset(0, -2) = ID & "." & L2
Case 3:  Zelle.Offset(0, -2) = ID & "." & L2 & "." & L3
Case 4:  Zelle.Offset(0, -2) = ID & "." & L2 & "." & L3 & "." & L4
End Select
'bei Text Aenderung next ID Nummer, L2-L4 löschen
If Lnxt  Zelle.Value Then ID = ID + 1: _
L2 = Empty: L3 = Empty: L4 = Empty
End If
Next Zelle
End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread