Numérotation multi niveau

jb_macro Messages postés 2 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention - 11 mai 2018 à 14:42

Bonjour

Je souhaiterais, à l'aide d'une Macro, automatiser la numérotation de mes lignes, dans la colonne B, sur plusieurs niveaux (01, 01.01 et 01.01.01.....) selon un repère (1, 2 et 3.....) dans colonne A

Le nombre de niveau est variable , mais peut aller jusque 20

J'ai trouvé une code VBA qui le fait très bien, mais qui ne gère que 3 niveau avec une numération (1, 1.1 et 1.1.1)

Je débute en vba, et je n'arrive pas a l'adapter

https://www.commentcamarche.net/forum/affich-4092209-excel-numerotation-sur-plusieurs-niveaux

Sub NOMMACRO()

Dim i%, j%, k%, Arr%(1 To 99)

With Worksheets("Métré")

j = .Range("A65536").End(xlUp).Row

.Range(.Cells(2, 2), .Cells(j, 3)).Font.Bold = False

.Range(.Cells(2, 3), .Cells(j, 3)).Font.Underline = xlUnderlineStyleNone

For i = 2 To j

k = .Cells(i, 1)

If k > 0 Then

.Cells(i, 3) = IIf(k = 1, UCase(.Cells(i, 3)), LCase(.Cells(i, 3)))

Arr(k) = Arr(k) + 1

If k < 2 Then Arr(2) = 0

If k < 3 Then Arr(3) = 0

If k = 1 Then

.Cells(i, 2) = Chr(160) & Arr(1)

.Range(.Cells(i, 2), .Cells(i, 3)).Font.Bold = True

.Cells(i, 3).Font.Underline = xlUnderlineStyleSingle

End If

If k = 2 Then .Cells(i, 2) = Chr(160) & Chr(160) & Arr(1) & "." & Arr(2)

If k = 3 Then .Cells(i, 2) = Chr(160) & Chr(160) & Chr(160) & Arr(1) & "." & Arr(2) & "." & Arr(3)

If k > 3 Then .Range(.Cells(i, 1), .Cells(i, 2)).ClearContents

Else

.Cells(i, 2).ClearContents

End If

Next

.Cells(i, 1).Activate

End With

End Sub

Merci d'avance pour votre aide !

Jerem

Afficher la suite

A voir également:

Numérotation multi niveau
Youtube multi downloader - Télécharger - Conversion & Codecs
Mise a niveau windows 7 vers 10 - Accueil - Mise à jour
Dans la présentation à télécharger, déplacez l'image dans le cadre sans en modifier la taille. redressez l'image pour que le niveau de la mer soit à l'horizontale. faites correspondre : la ligne avec le niveau de la mer ; le point avec le sommet de la grande voile. combien d'oiseaux sont dans le cadre ? - Forum Word
Sfr multi - Accueil - Opérateurs & Forfaits
Numérotation page word - Guide

1 réponse

Réponse 1 / 1

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

Sub NOMMACRO()
    Dim i As Long, j As Long, k As Long, Arr(1 To 99)   As Long

    With Worksheets("Métré")
        j = .Range("A65536").End(xlUp).Row
        .Range(.Cells(2, 2), .Cells(j, 3)).Font.Bold = False
        .Range(.Cells(2, 3), .Cells(j, 3)).Font.Underline = xlUnderlineStyleNone
        For i = 2 To j
            k = .Cells(i, 1)
            If k > 0 Then
                .Cells(i, 3) = IIf(k = 1, UCase(.Cells(i, 3)), LCase(.Cells(i, 3)))
                Arr(k) = Arr(k) + 1
                If k < 2 Then Arr(2) = 0
                If k < 3 Then Arr(3) = 0
                If k < 4 Then Arr(4) = 0
                If k = 1 Then
                    .Cells(i, 2) = Chr(160) & Arr(1)
                    .Range(.Cells(i, 2), .Cells(i, 3)).Font.Bold = True
                    .Cells(i, 3).Font.Underline = xlUnderlineStyleSingle
                End If
                If k = 2 Then
                    .Cells(i, 2) = Chr(160) & Chr(160) & Arr(1) & "." & Arr(2)
                ElseIf k = 3 Then
                    .Cells(i, 2) = Chr(160) & Chr(160) & Chr(160) & Arr(1) & "." & Arr(2) & "." & Arr(3)
                ElseIf k = 4 Then
                    .Cells(i, 2) = Chr(160) & Chr(160) & Chr(160) & Chr(160) & Arr(1) & "." & Arr(2) & "." & Arr(3) & "." & Arr(4)
                ElseIf k > 4 Then
                    .Range(.Cells(i, 1), .Cells(i, 2)).ClearContents
                End If
            Else
                .Cells(i, 2).ClearContents
            End If
        Next
        .Cells(i, 1).Activate
    End With

End Sub

jb_macro Messages postés 2 Date d'inscription Statut Membre Dernière intervention

Dsl pour la réponse tardive. j'ai compris la structure vba pour la macro, et j'ai su la faire fonctionner jusqu’à 15 niveau.
J'ai tjs le problème de format sur le code. la numérotation est 1.1.1.1 et non 01.01.01.01

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour
Ben vous n'aviez pas précisé ce petit détail!!!!

Jb_macro

Dsl, je pensai que c était clair qd j ai noté " sur plusieurs niveaux (01, 01.01 et 01.01.01.....)" mais ce n était pas forcément clair, dsl. En complément j ajouterai que un fois arriver à 09 j aimerai bien avoir 10 et pas 010.
Encore dsl pour le manque de précision dans l Enonce de mon probleme

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

Sub NOMMACRO()
    Dim i As Long, j As Long, k As Long, Arr(1 To 99) As Long

    With Worksheets("Métré")
        j = .Range("A65536").End(xlUp).Row
        .Range(.Cells(2, 2), .Cells(j, 3)).Font.Bold = False
        .Range(.Cells(2, 3), .Cells(j, 3)).Font.Underline = xlUnderlineStyleNone
        For i = 2 To j
            k = .Cells(i, 1)
            If k > 0 Then
                .Cells(i, 3) = IIf(k = 1, UCase(.Cells(i, 3)), LCase(.Cells(i, 3)))
                Arr(k) = Arr(k) + 1
                If k < 2 Then Arr(2) = 0
                If k < 3 Then Arr(3) = 0
                If k < 4 Then Arr(4) = 0
                If k = 1 Then
                    .Cells(i, 2) = Chr(160) & Arr(1)
                    .Range(.Cells(i, 2), .Cells(i, 3)).Font.Bold = True
                    .Cells(i, 3).Font.Underline = xlUnderlineStyleSingle
                End If
                If k = 2 Then
                    .Cells(i, 2) = String(2, Chr(160)) & Format(Arr(1), "00") & "." & Format(Arr(2), "00")
                ElseIf k = 3 Then
                    .Cells(i, 2) = String(3, Chr(160)) & Format(Arr(1), "00") & "." & Format(Arr(2), "00") & "." & Format(Arr(3), "00")
                ElseIf k = 4 Then
                    .Cells(i, 2) = String(4, Chr(160)) & Format(Arr(1), "00") & "." & Format(Arr(2), "00") & "." & Format(Arr(3), "00") & "." & Format(Arr(4), "00")
                ElseIf k > 4 Then
                ElseIf k > 4 Then
                    .Range(.Cells(i, 1), .Cells(i, 2)).ClearContents
                End If
            Else
                .Cells(i, 2).ClearContents
            End If
        Next
        .Cells(1, 1).Activate
    End With

End Sub

Discussions similaires

Recherche multi exp dans pokémon heart gold

Problème sur le câble d'antenne canal+

Pokémon SoulSilver multi exp

2eme multi exp?

Teste afpa niveau 3

Votre réponse

Discussions similaires