Index nummerering

Hvor har du "1" og hvor vil du have "2" osv.

Hvor har du "1.1" og hvor vil du have "1.2" og skal det fortsætte op til "1.9".

Prøv at forklare helt konkret og udtømmende, hvad det er, du ønsker.

Eks.

1. - linje 1 række 1
1.1. - linje 1 række 1 lige nedenfor
1.2. - linje under overstående

2.    Management and Employees
2.1.  xxxxxx
2.2.  xxxxxxxxxxx

Der bliver ofte lavet om i tekster og rækkefølger hvorfor jeg gerne vil have at nummereringen sker automatisk. punkt 2 skal derfor eks. sige A1+1 så den viser 2. og punktet under skal så gøre det at den fortsætter med 2.1. og så fremdeles.

Håber det giver mening

Manglede lige at tilføje - vil gerne kunne tage en tekst længere nede i arket (eks. under punkt 10) og så indsætte den under punkt 2 hvorefter den opdatere nummerrækken automatisk.

Hvis du har indexnumrene i kolonne A og teksten i kolonne B kan du bruge denne lille makro, som skal sættes ind under Vis koder, som kommer frem ved højreklik på faneblad. Makroen virker kun korrekt hvis der er en tom linie (og kun en) mellem hovedpunkterne. Makroen aktiveres hver gang der skrives i kolonne B

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
Dim LastRow As Long
y = 1
z = 0
Range("A:A").ClearContents
LastRow = Range("b65536").End(xlUp).Row
For x = 2 To LastRow ' Ret "2" så det passer med begyndelsesræken
If Cells(x, 2) <> "" Then
Cells(x, 1) = y & "." & z
z = z + 1
Else
y = y + 1
z = 0
End If
Next
End If
End Sub

Det virker jo perfekt.

Kan man gøre sådan at den viser et punktum efter hovedoverskrifter og imellem underområderne eks.

1.
1.1.

Tak

Vil det derudover være muligt at undgå de mellemrum mellem hovedoverskrifterne - sådan at hovedoverskriften aktiveres af hardcopy i række A. Det vil sige at hvis jeg er færdig med punkter i 1 herunder 1,1 1,2 etc. så indtaster 2 i kol. A så fortsætter den med 2,1 eftefter?

Du får lige en makro der skriver punktum i stedet for komma. Den sidste del skal jeg lige overveje først.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("b:b")) Is Nothing Then
Dim LastRow As Long
Range("A:A").NumberFormat = "@"
y = 1
z = 0
Range("A:A").ClearContents
LastRow = Range("b65536").End(xlUp).Row
For x = 2 To LastRow ' Ret "2" så det passer med begyndelsesræken
If Cells(x, 2) <> "" Then
If z = 0 Then
Cells(x, 1) = y
Else
Cells(x, 1) = (y & "." & z)
End If
z = z + 1
Else
y = y + 1
z = 0
End If
Next
End If
End Sub

Det er ser rigtig fint ud indtil videre. Tak

Jeg håber du kan bruge denne løsning. Den checker om der er brugt fed skrift i kolonne B. Eneste ulempe er at makroen ikke reagerer når der laves fed skrift. Den aktiveres først når der laves anden ændring i kolonne B

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("b:b")) Is Nothing Then
Dim LastRow As Long
Range("A:A").NumberFormat = "@"
y = 0
z = 0
Range("A:A").ClearContents
LastRow = Range("b65536").End(xlUp).Row
For x = 2 To LastRow
If Cells(x, 2).Font.Bold = True Then
z = 0
y = 1 + y
Cells(x, 1) = y
Else
z = z + 1
Cells(x, 1) = (y & "." & z)
End If
Next
End If
End Sub

Her er en anden makro, der checker på om der er lavet indrykning i cellerne i kolonne B. Den kan generere op til 5 indekseringsniveauer afhænging af hvor mange indrykninger der er lavet i cellen.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("b:b")) Is Nothing Then
Dim LastRow As Long
Dim IndLevel As Integer
Range("A:A").NumberFormat = "@"
y0 = 0
y1 = 0
y2 = 0
y3 = 0
y4 = 0
y5 = 0
Range("A:A").ClearContents
LastRow = Range("b65536").End(xlUp).Row
For x = 2 To LastRow
IndLevel = Cells(x, 2).IndentLevel
Select Case IndLevel
Case 0
y0 = y0 + 1
Cells(x, 1) = y0
y1 = 0
y2 = 0
y3 = 0
y4 = 0
y5 = 0
Case 1
y1 = y1 + 1
Cells(x, 1) = y0 & "." & y1
y2 = 0
y3 = 0
y4 = 0
y5 = 0
Case 2
y2 = y2 + 1
Cells(x, 1) = y0 & "." & y1 & "." & y2
y3 = 0
y4 = 0
y5 = 0
Case 3
y3 = y3 + 1
Cells(x, 1) = y0 & "." & y1 & "." & y2 & "." & y3
y4 = 0
y5 = 0
Case 4
y4 = y4 + 1
Cells(x, 1) = y0 & "." & y1 & "." & y2 & "." & y3 & "." & y4
y5 = 0
Case 5
y5 = y5 + 1
Cells(x, 1) = y0 & "." & y1 & "." & y2 & "." & y3 & "." & y4 & "." & y5
Case 5, 6, 7, 8, 9, 10, 11, 12
MsgBox ("Max. 5 indekseringsniveauer.")
End Select
Next
End If
End Sub

Løsningen med "fed" virker perfekt. Rigtig mange tak for hjælpen.

Vil også lige prøve at arbejde med din anden løsning.

Igen tak

Tror måske der er en lille bug i løsningen med "fed" skrift. Jeg starter altid i linje 4 grundet noget overskrift. etc. Selvom jeg ikke skiver i kol. B eller selvom både A og B er tomme i de første 4 linjer så indsætter det 1. dvs at jeg kan ikke indsætte overskrift og jeg kan ikke starte med nummer 1. i min første kat. Kan det ændres?

Derudover kan jeg se at hvis der er et mellemrum eks. mellem kat. 4 og 5 og selvomn der ikke fremgår noget tekst i kol b så indsætter den et underpunkt eks. 4.1 - ved ikke om det kan ændres. Hvis ikke så er det bare sådan. Har sjældent mellemrum

Hvis du vil starte i 4. linie skal linien med "For x = 2 to LastRow" blot ændres. Det er gjort med makroen nedenfor, hvor der også er ændret, så tomme linier ikke tælles med.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("b:b")) Is Nothing Then
Dim LastRow As Long
Range("A:A").NumberFormat = "@"
y = 0
z = 0
Range("A:A").ClearContents
LastRow = Range("b65536").End(xlUp).Row
For x = 4 To LastRow
If Cells(x, 2).Font.Bold = True And Cells(x, 2) <> "" Then
z = 0
y = 1 + y
Cells(x, 1) = y
Else
If Cells(x, 2) = "" Then
Else
z = z + 1
Cells(x, 1) = (y & "." & z)
End If
End If
Next
End If
End Sub

Rigtig mange tak

Kan du muligvis hjælpe med en enkelt tilføjelse.

I overskriftslinjen kan man her indsætte i makroen at den skal farve (grå farve) række A til F hvis man indsætter en hovedoverskrift?

Eks. indsætter en ny række. Markeret kol. B med fed hvorefter makroen indæstter eks. punkt 2. Kan man i samme ombæring få den til at farve linjen med den grå farve?