Trouver le "père"

Version imprimable

08/01/2010, 15h59
peshko60

Trouver le "père"

Bonjour,

Tout d'abord je tiens à m'excuser si jamais cette question a déjà été posée (j'ai parcouru les différents sujets mais je n'ai pas trouvé ce que je cherchais).

Je dois gérer une nomenclature technique complexe (environ 12 000 liens) qui se compose visuellement comme suit :

Article A
Article B
Articl C
Article F
Articl D
Article E

Et qui signifie que C est le fils de B qui est le fils de A etc.
Dans la base de données les données sont stockées dans deux colonnes (A et B) :

Article C Article B
Article B Article A
Article F Article A
Article E Article D

Je souhaiterais trouver le dernier père pour chaque article. Dans mon exemple le dernier père de l'article C est l'article A.

Un article peut avoir 10 pères au maximum.

Ainsi, je souhaiterais que les colonnes C à L soient resnsegnées avec la valeur de la colonne B qui correspond au dernier père de la colonne A, soit :

Article C Article B Article A
Article B Article A Article A
Article F Article A Article A

Je suppose que cela passe par des boucles Do While et For Each mais je n'arrive pas à créer cette macro.

je vous remercie par avance de votre aide.

Cordialement

Bonjour

Ci dessous un code à tester et à améliorer

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
 
Option Explicit
Dim tablo() As String
Dim code1() As String
Dim code2() As String
Dim i As Byte
 
Sub travdem()
Dim cellule As Range
Dim nomfeuille1 As String
Dim lig As Long
 
' pour boucler sur la colonne 1
 
nomfeuille1 = "Feuil1"
 
With Sheets(nomfeuille1)
For Each cellule In .UsedRange.Columns(1).Cells
    cellule.Offset(0, 1) = cellule & " "
    If cellule <> "" Then
    tablo() = Split(cellule, " ")
    Call decomp(1)
        If code1(1) <> "" Then
        lig = rechercheligne(nomfeuille1, "a", code1(1), cellule.Row + 1)
        If lig > 0 Then
        cellule.Offset(0, 1) = cellule.Offset(0, 1) & "Article" & " " & code1(1)
        End If
        End If
    End If
Next cellule
End With
End Sub
 
 
'----------------------------------------------
'
 
Private Function rechercheligne(£feuille As String, £colonne As String, £dataf As String, £depart As Long)
Dim £dataf1 As String
Dim £if1 As Integer
Dim £if2 As Long, £dl1 As Long
Dim £cell As Range
 
With Sheets(£feuille)
£dl1 = .Range(£colonne & Rows.Count).End(xlUp).Row
If £depart <= £dl1 Then
 
    For Each £cell In .Range(£colonne & £depart & ":" & £colonne & £dl1)
        tablo() = Split(£cell, " ")
        Call decomp(2)
        If code2(0) = £dataf Then
            rechercheligne = £cell.Row
            Exit Function
        End If
 
    Next £cell
  rechercheligne = 0
 End If
 End With
End Function
' décomposition du texte pour mettre en évidence les codes
' val1 sert simplement à indiquer la variable pour la réponse
Private Sub decomp(val1 As Byte)
Dim j As Byte
Dim data1 As String
j = 0
i = LBound(tablo)
data1 = ""
Do
If tablo(i) = "Article" Then
    If data1 = "" Then
        data1 = tablo(i + 1)
    Else
        data1 = data1 & "/" & tablo(i + 1)
    End If
 
End If
i = i + 1
If i > UBound(tablo) Then Exit Do
Loop
If val1 = 1 Then code1() = Split(data1, "/")
If val1 = 2 Then code2() = Split(data1, "/")
End Sub

JP014

08/01/2010, 21h34
peshko60

1 pièce(s) jointe(s)

Merci beaucoup pour cette aide.

Néanmoins, lorsque je lance le code j'ai une erreur d'exécution n°9 et a priori il s'arrête à la première ligne.

malheureusement, le code est trop compliqué pour moi et je n'arrive pas à le comprendre.

Je joins un fichier simple, les données sont dans les deux premières colonnes et le résultat voulu est dans les colonnes suivantes.
08/01/2010, 22h29
LeForestier

Bonjour,
Je ne comprend pas ce que tu veux dire :oops:
Et si jp014 à compris 8O, il manque les redim dans sont code.
A+
09/01/2010, 09h57
jp014

Bonjour peshko60
Bonjour LeForestier

La procédure est basé sur les données indiquées
Article C Article B
Article B Article A
Article F Article A
Article E Article D

Le code

Code:

tablo() = Split(cellule, " ")

Permet d'extraire les nom des articles à savoir la deuxième et quatrième position.
J'ai loupé la phrase
"Dans la base de données les données sont stockées dans deux colonnes (A et B)"

Concernant le fichier envoyé je n'ai pas compris la structure des données.

JP014

Bonjour.

Je propose de travailler avec une classe perso, car elle permet une hiérarchisation sans devoir se préoccuper du nombre de niveaux.

Présupposé: Chaque article doit se trouver une seule fois en colonne A, même celui qui n'a pas de parent (A par exemple). En B, on trouve soit le code de l'article parent, soit rien (article orphelin).

Ce présupposé est à mon sens obligatoire et incontournable.

Après, on crée une classe perso cArticle possédant deux propriétés:
Numero, qui reprend le numéro de l'article de type String
Parent, de type cArticle qui contiendra l'article parent s'il existe

Pour cela, il faut créer un module de classe, le nommer cArticle et placer le code suivant (C'est une classe très simple)
Code:

1 2 3 4 Option Explicit Public Numero As String Public Parent As cArticle
Après, on boucle une première fois pour charger une collection avec les articles en A (une fois chaque article, donc).

On boucle une deuxième fois pour charger les parents. Boucler en deux étapes pour charger les articles et leurs parents évite de passer par une procédure récursive. De plus, comme on a chargé chaque article dans collection à la boucle 1, on est certain que si parent il y a, il est chargé dans la collection

On boucle une troisième fois pour décharger chaque parent tant qu'il y en a, chaque parent étant lui-même le fils de son père, s'il n'est pas orphelin. S'il est orphelin, on passe à l'article suivant.

Voici la procédure à utiliser dans un module standard. Elle est à adapter en fonction de tes besoins.
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 Sub Arborescence() Dim oCollection As New Collection Dim Cellule As Range Dim oArticle As cArticle Dim oParent As cArticle Dim Colonne As Integer ' Chargement de chaque article dans la collection For Each Cellule In Range(Range("a2"), Range("a" & Rows.Count).End(xlUp)) Set oArticle = New cArticle oArticle.Numero = Cellule.Value oCollection.Add oArticle, oArticle.Numero Next Cellule ' Attribution de l'article parent à chaque article, si l'article n'est pas orphelin For Each Cellule In Range(Range("a2"), Range("a" & Rows.Count).End(xlUp)) Set oArticle = oCollection.Item(Cellule.Value) If Cellule(1, 2) <> "" Then Set oParent = oCollection.Item(Cellule(1, 2)) ' Chaque parent devient article pour permettre l'extraction de son père Set oArticle.Parent = oParent End If Next Cellule ' Chaque parent devient à son tour article pour remonter d'un niveau dans l'arbre For Each Cellule In Range(Range("a2"), Range("a" & Rows.Count).End(xlUp)) Colonne = 3 Set oArticle = oCollection.Item(Cellule.Value) Do While Not oArticle.Parent Is Nothing Cellule(1, Colonne) = oArticle.Parent.Numero Set oArticle = oArticle.Parent Colonne = Colonne + 1 Loop Next Cellule End Sub
Cette solution met en lumière un travail avec une classe perso et une collection.
Complément d'info sur les classes perso

2 pièce(s) jointe(s)

Bonjour

Ci dessous la procédure modifiée

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
61
62
Option Explicit
Dim i As Byte, j As Byte
 
Sub travdem()
Dim cellule As Range
Dim nomfeuille1 As String
Dim lig As Long
Dim data1 As String
' pour boucler sur la colonne 1
 
nomfeuille1 = "Feuil2"
 
With Sheets(nomfeuille1)
For Each cellule In .UsedRange.Columns(1).Cells
 
    data1 = cellule.Offset(0, 1)
    If cellule <> "" Then
        i = 1
        j = 2
        Do
 
            lig = rechercheligne(nomfeuille1, "a", data1, 2, cellule.Row)
            If lig = 0 Then Exit Do
            If lig > 0 Then
                cellule.Offset(0, j) = .Cells(lig, 2)
                i = i + 1
                j = j + 1
                data1 = .Cells(lig, 2)
            End If
            If data1 = "" Then Exit Do
        Loop
    End If
Next cellule
End With
End Sub
 
 
'----------------------------------------------
'
 
Private Function rechercheligne(£feuille As String, £colonne As String, £dataf As String, £depart As Long, £celencours As Long)
Dim £dataf1 As String
Dim £if1 As Integer
Dim £if2 As Long, £dl1 As Long
Dim £cell As Range
 
With Sheets(£feuille)
£dl1 = .Range(£colonne & Rows.Count).End(xlUp).Row
If £depart <= £dl1 Then
 
    For Each £cell In .Range(£colonne & £depart & ":" & £colonne & £dl1)
        If £celencours <> £cell.Row Then
            If £cell = £dataf Then
                rechercheligne = £cell.Row
                Exit Function
            End If
        End If
    Next £cell
  rechercheligne = 0
 End If
 End With
End Function

La recherche se fait a partir de la ligne2.
Ci joint des images, avant de lancer la procédure, et après.

A tester

JP014

09/01/2010, 12h17
peshko60

Bonjour,

Merci à tous pour vos apports, je vais tester cela de suite.

Néanmoins, je vais essayer d'expliquer en "français" la situation :

Dans la colonne A (composant), un article peut se trouver plus d'une fois car il peut faire partie de deux ou plus de produits finis.

En effet, la nomenclature technique se présente visuellement comme un arbre avec des différentes "bifurcations".

Informatiquement, tous les liens (appelés "père -fils") sont traduits dans deux colonnes : première colonne "le composant", deuxième colonne "le composé".
Mais un "composé" peut être le "composant" d'un ou plusieurs autres "composés".

Au total, j'ai 10 articles qui ne sont le "composant" d'aucun autre (je les appelle des produits finis).

Donc, je cherche à indiquer en face de chaque article dans quels produits finis il se trouve.

Je teste vos derniers codes et je reviens vers vous.

Encore une fois merci pour votre aide.
09/01/2010, 12h22
Pierre Fauconnier

Alors, tu ne peux pas appeler ta relation "père-fils", car un fils ne peut avoir qu'un père. De plus, il est toujours plus intéressant et rentable de définir le contexte exact dès le départ...

Les solutions proposées ne peuvent fonctionner dans ce cas, puisque les recherches du composant vont toujours tomber sur le premier...

Voici une solution.

Toujours avec une classe, des collections, et une fonction récursive pour déterminer si un composant fait partie d'un composé.

Je passe sur la conception du classeur, car il me semblerait intéressant d'avoir sur une feuille la liste sans doublons de tous les articles (composants et produits finis). Cela permettrait de ne pas devoir tester si un composant est déjà dans la collection des articles avant de l'y mettre, et de ne tester la "filiation" d'un composant qu'une seule fois, alors que dans le cas de ta feuille, on établira la liste des produits finis contenant un composant autant de fois que l'on trouve ce composant en A...

La classe CArticle contiendra deux propriétés:
- le numéro de l'article
- la collection de ses composants directs

1) Chaque article (composant ou produit fini) doit au moins se trouver une fois en A, même sans rien en B (cas du produit fini). Un composant qui intervient dans plusieurs produits finis ou autres composants sera présent plusieurs fois en A.

2) On crée une collection de produits dans laquelle chaque produit (composant et produit fini) se trouve une seule fois.

3) Pour chaque article, on détermine la collection de ses composants directs. Cette collection est une propriété de chaque objet typé cArticle

4) On établit la collection des produits finis, qui sont les produits en A pour lesquels on n'a rien en B (Ils ne sont composants d'aucun autre produit)

5) Grâce à la fonction récursive EstComposantDe, on détermine si un composant remonte jusqu'à un produit fini par filiation. Cette fonction reçoit en paramètres un composant et un composé, et renvoie VRAI ou FAUX.

Voici le code de la classe cArticle, toujours aussi simple
Code:

1 2 Public Numero As String Public Composants As New Collection
Ce code doit être placé dans un module de classe nommé cArticle

Dans un module standard, on place la procédure suivante, qui réalise les étapes vues plus haut
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 Sub RetrouverProduitsFinis() Dim Cellule As Range Dim oArticle As cArticle Dim cArticles As New Collection Dim Colonne As Integer Dim cProduitsFinis As New Collection ' Chargement de chaque article (une seule fois) dans la collection For Each Cellule In Range(Range("a2"), Range("a" & Rows.Count).End(xlUp)) If Not ArticleExisteDansCollection(Cellule.Value, cArticles) Then Set oArticle = New cArticle oArticle.Numero = Cellule.Value cArticles.Add oArticle, oArticle.Numero End If Next Cellule ' On établit la collection des composants par article For Each Cellule In Range("b2:b" & Range("a" & Rows.Count).End(xlUp).Row) If Not Cellule.Value = "" Then Set oArticle = cArticles.Item(Cellule.Value) oArticle.Composants.Add cArticles.Item(Cellule(1, 0).Value) End If Next Cellule ' on crée la liste des produits finis dans la collection ad hoc ' Un produit fini est un produit qui n'est pas composant d'un autre, soit un produit qui est en A et pas en B For Each Cellule In Range(Range("a2"), Range("a" & Rows.Count).End(xlUp)) If Cellule(1, 2) = "" Then cProduitsFinis.Add cArticles.Item(Cellule.Value) Next Cellule ' Gràce à la récursive, on teste si un produit est composant d'un autre For Each Cellule In Range(Range("a2"), Range("a" & Rows.Count).End(xlUp)) Colonne = 3 For Each oArticle In cProduitsFinis If EstComposantDe(cArticles.Item(Cellule.Value), oArticle) Then Cellule(1, Colonne) = oArticle.Numero Colonne = Colonne + 1 End If Next oArticle Next Cellule End Sub
Pour travailler, cette procédure a besoin de deux fonctions.

La première sert à n'ajouter qu'une seule fois chaque article dans la collection des articles en testant si l'article est déjà présent dans la collection
Code:

1 2 3 4 5 6 7 8 9 10 11 Function ArticleExisteDansCollection(Numero As String, oCollection As Collection) As Boolean ' On teste si un article est déjà présent dans la collection des articles Dim oArticle As cArticle For Each oArticle In oCollection If oArticle.Numero = Numero Then ArticleExisteDansCollection = True Exit For End If Next oArticle End Function
Si on disposait d'une feuille (table) avec la liste sans doublons des articles et produits finis, on pourrait se passer de cette fonction.

La seconde fonction est la fonction récursive, qui reçoit dont en paramètres un composant et un composé. La procédure RetrouverProduitsFinis appelle donc cette fonction pour chaque article en A, en passant chaque produit fini en second paramètre. Cette fonction s'appelle elle-même (récursivité) autant de fois qu'il est nécessaire pour "épuiser" tous les composants du produit fini au travers de l'arbre.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Function EstComposantDe(Composant As cArticle, Compose As cArticle) As Boolean ' Fonction récursive pour déterminer si Composant est contenu dans Compose 'Static ComposantTrouve As Boolean Dim oArticle As cArticle If Composant.Numero = Compose.Numero Then EstComposantDe = True Exit Function Else For Each oArticle In Compose.Composants EstComposantDe = (EstComposantDe Or EstComposantDe(Composant, oArticle)) ' <= récursivité Next oArticle End If End Function

11/01/2010, 08h25
peshko60

Merci beaucoup pour votre aide.

La solution de Pierre Fauconnier fonctionne et répond à mon besoin.

Merci encore