Macro générant un arbre généalogique des composants et assemblages d'un produit [Résolu]

[RicoExo]

Bonjour !

Je tente actuellement de développer un arbre généalogique de composants et d’assemblages. C'est-à-dire que pour un assemblage donné j’aimerai voir ses sous-assemblages et les sous-assemblages de ceci jusqu’aux niveaux des composants du dernier sous assemblage et ceci par produit (ou projet comme je les appelle ici).

J’ai commencé à faire quelque chose en VBA mais comme je suis novice, je n’arrive pas à faire ce que je souhaite exactement. Je ne maitrise pas très bien les boucles et les stockages de variables.

Le fichier joint est composé de 4 onglets :
1. « TableRelation » : c’est la base de données avec en colonne A les assemblages enfants et de leur désignation (colonne B). Les assemblages parents (directs) associés sont en colonne C. Enfin la colonne H gère l’appartenance à un produit (ou projet) ;
2. « test » : La macro utilise la cellule A1 pour générer la liste des premiers assemblages enfants directs sur cette même feuille ;
3. « Feuil1 » : génère l’arbre généalogique sur 2 niveaux ;
4. « CdC » : c’est ce que j’aimerai obtenir lorsque je lance la macro pour le produit z1 (assemblage maitre ->9000001)

Le challenge est de faire des boucles pour générer ce que j’ai commencé à faire sur 2 niveaux à n niveaux pour un produit choisi.
Les références des assemblages ont leurs 3 premiers chiffres qui dépendent du projet donc on peut faire des règles qui permettent de sélectionner uniquement les assemblages et composants appartenant à celui-ci.

Est-ce que quelqu’un pourrait me donner un coup de main ?

Merci beaucoup d’avance !

TableurArbreGéné.xlsx

Code (module à activer dans la feuille "test"):

Code :

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
51
52
53
54
55
56
57
58
59
60
Sub test()
 
Dim plageassmpar, plageassmenf As Range
Dim n, i, j, k, l As Integer
 
n = Worksheets("TableRelation").Range("A65536").End(xlUp).Row   'Nbre de lignes de la base de données
a = 200                                                         'Nbre max d'assemblages enfants directs pour un assemblage
 
'----------------
'On va stocker les assemblages enfants directs pour les utiliser par la suite dans la feuille suivante
 
For i = 2 To n
    If Worksheets("TableRelation").Range("C" & i).Value = Worksheets("test").Range("A1").Value Then
        j = 1
        While j < 200
            If Worksheets("test").Range("C" & j).Value = "" Then
                Worksheets("test").Range("C" & j).Value = Worksheets("TableRelation").Range("A" & i).Value
                Worksheets("test").Range("D" & j).Value = Worksheets("TableRelation").Range("B" & i).Value
                j = 200
            Else
                j = j + 1
            End If
        Wend
    End If
Next i
 
m = Worksheets("TableRelation").Range("C65536").End(xlUp).Row
k = 1
 
'----------------
'On va générer l'arbre généalogique sur 2 niveaux
 
Worksheets("Feuil1").Range("A1").Value = Worksheets("test").Range("A1").Value
Worksheets("Feuil1").Range("B1").Value = Worksheets("test").Range("B1").Value
Worksheets("Feuil1").Range("C1").Value = Worksheets("test").Range("C1").Value
Worksheets("Feuil1").Range("D1").Value = Worksheets("test").Range("D1").Value
 
While Worksheets("test").Range("C" & k).Row < m
    For l = 2 To n
        If Worksheets("TableRelation").Range("C" & l).Value = Worksheets("test").Range("C" & k).Value Then
            j = 1
            While j < 200
                If Worksheets("Feuil1").Range("E" & j).Value = "" And Worksheets("test").Range("E" & j + 1).Value = "" Then
                    Worksheets("Feuil1").Range("E" & j).Value = Worksheets("TableRelation").Range("A" & l).Value
                    Worksheets("Feuil1").Range("F" & j).Value = Worksheets("TableRelation").Range("B" & l).Value
                    j = 200
                Else
                    j = j + 1
                End If
            Wend
        End If
    Next l
    k = k + 1
    o = Worksheets("Feuil1").Range("E65536").End(xlUp).Row
    Worksheets("Feuil1").Range("C" & o).Value = Worksheets("test").Range("C" & k).Value
    Worksheets("Feuil1").Range("D" & o).Value = Worksheets("test").Range("D" & k).Value
Wend
 
 
End Sub

[pressdell]

Bonjour RicoExo,

J'avoue que j'ai un peu le même type de projet en tête depuis peu.
Afin de me rafraîchir un peu la mémoire sur les notions d'arbres en informatique, j'ai relu un exposé fort intéressant de Romuald Perrot sur ce site.

L'exploitation des relations Parents/Enfants fonctionne bien via l'utilisation de la récursivité. Je l'avais mise en pratique lors de mes études, mais c'était en Java, et non en VBA...nous pourrions certainement utiliser les Collections en VBA, mais je ne me suis pas encore vraiment penché sur le sujet.

J'essaye de regarder cela ce soir.

EDIT : Un premier lien à consulter

Cordialement.

[RicoExo]

J'ai finalement réussi à faire cette macro.

Pour ceux qui sont intéressés voici le fichier en pièce jointe.

Procédure:
1-Feuille "test" écrire dans la cellule (1,1) la référence d'un assemblage présent dans la feuille "TableRelation" (ils commencent par 9)
2-Feuille "test2" faire la même chose
3-Lancer ma macro "tri"
4-Lancer la macro "misenforme"

Ca devrait fonctionner (attendre 20 à 30s chaque module), le résultat sera dans la feuille "test2"! Ca pourrait être mieux programmé mais bon j'ai pas trop le temps de l'améliorer, avis aux amateurs.

Voilà!

Rico


Proposition Arbre Géné.zip