Discussion :

[rhumbielle]

Bonjour à tous,

Et merci d'avance pour votre aide
Mon problème est le suivant, j'aimerais rendre l'arborescence d'une nomenclature automatique, dans le but de pouvoir la modifier et de ne pas la réecrire à la main à chaque fois


La macro devrait donc, pour chaque ligne, chercher si la colonne est remplie ou non, et si oui, incrémenter la valeur : 1
Passer à la colonne suivante, ajouter un "." le cas échéant et incrémenter la seconde variable : 1.1
Puis colonne suivante, ajouter un "." le cas échéant et incrémenter la troisième variable : 1.1.1
Etc.

Ca parait tout simple mais je ne m'en sors pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub arborescence()
Dim i As Integer 'nomenclature niveau 1
Dim j As Integer  'nomenclature niveau 2
Dim k As Integer 'nomenclature niveau 3
Dim l As Integer 'nomenclature niveau 4
Dim p As String
Dim li As Integer 'ligne
 
i = 1
j = 1
k = 1
l = 1
p = "."
 
 
Sheets("Convoyage de la canne (1-2)").Activate
li = 2
If Cells(li, 3) <> "" Then Cells(li, 7).Value = i
    ElseIf Cells(li, 4) <> "" Then Cells(li, 7).Value = i&p

Merci pour votre aide !!

test nomenclature.xlsm

[ARTURO83]

Bonjour,

Essayez ceci
Pièce jointe 531066

Le code associé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Option Compare Text
 
Sub Arborescence()
    Dim p As String
    Dim DerLig As Long
    Dim Niv As String, Niv1 As String, Niv2 As String, Niv3 As String
    Dim N1 As Integer, N2 As Integer, N3 As Integer
 
    p = "."
 
    Application.ScreenUpdating = False
    Sheets("Convoyage de la canne (1-2)").Activate
    DerLig = Range("D" & Rows.Count).End(xlUp).Row
    Range("G5:G" & DerLig).ClearContents
    Niv1 = Cells(4, "D")
    Niv2 = Cells(4, "E")
    Niv3 = Cells(4, "F")
    N1 = 0
    N2 = 0
    N3 = 0
    For i = 5 To DerLig
        If Cells(i, "D") <> Niv1 Then
            N1 = N1 + 1
            Cells(i, "G") = N1
            N2 = 0
            N3 = 0
            Niv1 = Cells(i, "D")
        ElseIf Cells(i, "D") = Niv1 And Cells(i, "E") <> "" Then
            If Cells(i, "E") <> Niv2 Then
                If Cells(i, "F") <> "" Then
                    N2 = N2 + 1
                    N3 = N3 + 1
                    Cells(i, "G") = N1 & p & N2 & p & N3
                    Niv2 = Cells(i, "E")
                Else
                    N2 = N2 + 1
                    Cells(i, "G") = N1 & p & N2
                    N3 = 0
                    Niv2 = Cells(i, "E")
                End If
            ElseIf Cells(i, "E") = Niv2 Then
                If Cells(i, "F") <> "" Then
                    N3 = N3 + 1
                    Cells(i, "G") = N1 & p & N2 & p & N3
                    Niv3 = Cells(i, "F")
                End If
            End If
        End If
    Next i
End Sub

Cdlt

[Menhir]

Une version un peu plus concise.
En supposant que tes entêtes de colonne sont en ligne 1 (sinon, il faudra changer le 2 dans le For To) et que les "Machine" sont en colonne A.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub Arborescence()
    Dim Lig As Long, N(3) As Long
    N(1) = 0 : N(2) = 0 : N(3) = 0
    Sheets("Convoyage de la canne (1-2)").Activate
 
    For Lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        N(1) = N(1) + IIf(Cells(Lig, 2) = "", 1, 0)
        N(2) = IIf(Cells(Lig, 2) = "", 0, N(2) + IIf(Cells(Lig, 3) = "", 1, 0))
        N(3) = IIf(Cells(Lig, 3) = "", 0, N(3) + 1)
        Cells(Lig, 4).Valus = N(1) & IIf(N(2) = 0, "", "." & N(2) & IIf(N(3) = 0, "", "." & N(3)
    Next Lig
End Sub

Je n'ai pas testé ce code, il se peut donc qu'il y ait du débugage à faire.