Excel – Makro pro přečíslování víceúrovňového seznamu

V projekční dokumentaci se často používají číslované seznamy, přinejmenším pro samotný seznam příloh této dokumentace.

Pokud je seznam ručně vytvořený (statický) a k tomu rozsáhlý a s více úrovněmi, každé vložení nebo odebrání položky znamená fádní přečíslovávání.

Ve Wordu můžeme použít propracované dynamické víceúrovňové seznamy, a to nejen pro seznamy samotné, ale i pro číslování kapitol a nadpisů.

Word ale není vůbec vhodný na jakoukoli jen trochu komplexnější správu seznamu příloh. Pokud do něj vkládáme další informace, například stav a průběh zpracování, vložené seznamy pracovních úkolů, zpracovatele a podobně, potřebujeme tabulku – Excel.

Prostý seznam s jednou úrovní a jednou položkou na každém řádku vytvoříme jednoduše. Stačí zadat první dvě hodnoty, vybrat je a buď přetažením nebo dvojklikem na úchyt doplnit do ostatních řádků:

Je to ale pořád statický seznam, takže tuto akci musíme provést při každé další změně.

Aby se jednoduchý seznam choval dynamicky, není taky nijak složité. Použijeme funkci ŘÁDEK (vrací číslo řádku). Pokud nezačínáme na prvním řádku, odečteme číslo řádku nad naším seznamem:

=ŘÁDEK()-ŘÁDEK($B$1)

Opět funkci zadáme do prvního řádku a přetažením nebo dvojklikem doplníme do ostatních.

Při vložení nového řádku do něho stačí funkci doplnit. Při smazání nemusíme dělat nic:

Pro jednoúrovňové seznamy je to dobré řešení. Co ale víceúrovňový seznam?.

Excel obsahuje mnoho funkcí a možností, expert by je možná dokázal nakombinovat tak, jak potřebujeme. Ale někdy může být jednodušší, když si napíšeme funkci vlastní. S trochou znalostí VBA to není nic složitého a výsledek může fungovat takto:

Provedeme potřebné změny – přidání nebo odebrání řádků. Vybereme startovní buňku, tj. tu, která obsahuje poslední správnou položku, podle které chceme všechny další přečíslovat. A spustíme makro.

Předpokladem je, že ve sloupci pod startovní buňkou není nic jiného než další položky seznamu nebo prázdné buňky.

Seznam musí být pouze numerický, alfabetický není podporován.

Jak je vidět na videu, před číslem může být libovolné písmeno, není ale nijak řešeno, pouze se kopíruje. Může jich být i víc (ABC, A-B-C), avšak pouze bez teček (A.B.C je špatně).

Tečka jako oddělovač může být změněna na jiný znak, například pomlčku, přímo v textu makra. Je to konstanta sep:

Const sep As String = "."

Celý kód, včetně základní kontroly vstupů:

Const tit As String = "JskRenumber"
Const sep As String = "."
Dim ac As Range, cc As Range
Dim sa() As String
Dim lev As Integer, clev As Integer
Dim val As Variant
Dim i As Long, lr As Long

    Set ac = ActiveCell
    If Len(ac) = 0 Then
        MsgBox "Funkci nelze spustit." & vbCrLf & "Je vybrána prázdná buňka.", vbCritical, tit
        Exit Sub
    End If
    
    sa = Split(ac, sep)
    lev = UBound(sa)
    val = sa(lev)
    If IsNumeric(val) = False Then
        MsgBox "Funkci nelze spustit." & vbCrLf & "Hodnotu nelze převést na číslo.", vbCritical, tit
        Exit Sub
    End If

    lr = Cells(ActiveSheet.Rows.Count, ActiveCell.Column).End(xlUp).Row
    For i = 1 To lr
        Set cc = ac.Offset(i, 0)
        If Len(cc) <> 0 Then
            sa = Split(cc, sep)
            clev = UBound(sa)
            If clev < lev Then Exit Sub
            If clev = lev Then
                On Error Resume Next
                val = val + 1
                sa(lev) = val
            Else
                sa(lev) = val
            End If
            cc = Join(sa, sep)
        End If
    Next i

End Sub

Pokud se vám toto makro hodí, zkopírujte jeho kód do osobního sešitu maker a můžete ho začít používat.

A pokud nepracujete s editorem maker, můžete si stáhnout sešit, který toto makro obsahuje. Otevřete ho, přejděte do sešitu s vaším seznamem, vyberte startovní buňku, otevřete dialog Makro (Alt + F8) a spusťte Přečíslovat.xlsm!JskReNumber.

Štítky

Vytvořte si web nebo blog na WordPress.com