[VBA-Excel] Construction d'un arbre d'appels

Résolu
Signaler
Messages postés
6
Date d'inscription
vendredi 23 avril 2004
Statut
Membre
Dernière intervention
31 juillet 2007
-
Messages postés
6
Date d'inscription
vendredi 23 avril 2004
Statut
Membre
Dernière intervention
31 juillet 2007
-
Bonjour,


Je me retrouve face à un petit problème, j'espère que vous saurez m'indiquer une direction…


Voici la feuille Excel que j'ai en entrée ( chaque chaine se trouve dans une cellule à partir de la A1 ) :

Chaine3 Chaine4
Chaine3 Chaine7
Chaine1 Chaine2
Chaine1 Chaine3
Chaine6 Chaine5
Chaine6 Chaine3
Chaine5 Chaine4
Chaine5 Chaine7
Chaine7 Chaine8
Chaine7 Chaine9

Et voici la feuille Excel que je dois obtenir en sortie ( partir de la cellule A1 toujours ) :

Chaine1 Chaine2
....... Chaine3 Chaine4
............... Chaine7 Chaine8
....................... Chaine9
Chaine6 Chaine5
....... Chaine3 Chaine4
............... Chaine7 Chaine8
....................... Chaine9

En gros, lorsqu'on parcourt les cellules de la première colonne, s'il
s'avère que l'une d'entre elles se trouve aussi dans la seconde
colonne, cela signifie que cette chaine est de second niveau, et doit
donc être inscrite dans la colonne cible + 1, et non la colonne cible


J'ai pensé à un algorithme de ce type :

Pour chaque cellule de la première colonne

Chercher cette cellule dans la seconde colonne

Si trouvée
Alors cette celulle est de second niveau, donc onne l'écrit pas encore
Si non trouvée
Alors écrire cette cellule dans la colonne cible de la seconde feuille
écrire sa celulle adjacente dans la colonne cible adjacente de la seconde feuille
FinSi

Passage à la cellule de la première colonne suivante

FinPour

Qu'est-ce que vous en pensez ? Avez-vous une idée du code ?

Je planche dessus depuis deux jous et j'avoue sécher complètement ...


Merci d'avance !

8 réponses

Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
Bon ben j'ai pondu quelque chose,
mais au fur et à mesure que je codais je me suis dit "C'est de moins en moins simple ce que tu fais"
Mais bon ca à au moins le mérite de te mettre sur la voix.

'Exemple d'élément
   'Nom = Chaine1
   'SousElements(0) = Chaine2
   'SousElements(0) = Chaine3
Private Type Element
   Nom As String
   SousElements() As String
End Type

'Tableau regroupant tout les éléments
'possédant des sous elements
'Exemple AUCUN éléments dont le nom = Chaine2
Private Elements() As Element
'Collection indexée par nom d'élément
'permettant de stocke l'indice d'un élément
'dans le tableau Elements
Private PElements As New Collection

Private Sub CommandButton1_Click()
'Variables de boucle
   Dim ObjRangeA As Range
   Dim ObjRangeB As Range
   Dim i As Integer
'Booleen Faux si valeur non trouve dans colonne B
   Dim CelTrouve As Boolean
'Collection
   Dim NiveCell As New Collection
'Element Temporaire
   Dim TmpElem As Element
'Numéro de la ligne
   Dim NumLigne As Long
   NumLigne = 1
   'Selection de la plage de travail
   Range("A1").Select
   Range("A1:A" & Selection.End(xlDown).Row).Select

   'remplissage de la collection permettant de connaitre le
   'nom de nos éléments (valeur colonnes A sans doublons)
   On Error Resume Next
       'Pour chaque cellule de la plage de travail
       For Each ObjRangeA In Selection
           'ajout du nom à la collection
           'erreur ignorée si element déjà existant
           'Dans l'exemple nom ajoutés:
           'Chaine3, Chaine1, Chaine6, Chaine5, Chaine7
           Call NiveCell.Add(ObjRangeA.Value, ObjRangeA.Value)
       Next
       'Redimensionnement du tableau d'éléments
       'on connais à présent la taille dans l'exemple => 5
       ReDim Elements(1 To NiveCell.Count)
   On Error GoTo 0
   
   'Remplissage à proprementparlé
   'du tableau d'éléments
   'pour chaque élément de la collection
   For i = 1 To NiveCell.Count
       'remplissage de l'élément temporaire
       With TmpElem
           .Nom = NiveCell.Item(i)
           'Redimensionnement des sous ensembles
           ReDim .SousElements(0)
           'Pour chaque cellule de la plage de travaille
           For Each ObjRangeA In Selection
               'Si la valeur de la cellule est égal au nom
               If ObjRangeA.Value = .Nom Then
                   'Tableau de sous ensemble = valeur en colonne B
                   .SousElements(UBound(.SousElements)) = Range("B" & ObjRangeA.Row).Value
                   'Redimensionnement dynamique pour préparer un espace
                   'pour un autre sous ensemble
                   ReDim Preserve .SousElements(UBound(.SousElements) + 1)
               End If
           Next
           'On détruit le dernier sous ensemble car forcément vide
           ReDim Preserve .SousElements(UBound(.SousElements) - 1)
       End With
       'On replit le tableau d'élément avec l'élément créé
       Elements(i) = TmpElem
       On Error Resume Next
       'on rempli la collection de correspondance NomElem Indice
       Call PElements.Add(i, TmpElem.Nom)
       On Error GoTo 0
   Next
       
   'Nous allon à présent remplir la NiveCell
   'Avec les Valeurs "SOUCHES" i.e celle n'étant pas
   'dans la colonne B
   Set NiveCell = New Collection
   'Pour Chaque cellule de la plage de travail
   For Each ObjRangeA In Selection
       'Mize à False du Flag
       CelTrouve = False
       'Pour chaque cellule de la colonne B et de la zone de travail
       For Each ObjRangeB In Range("B1:B" & Selection.End(xlDown).Row)
           'Si les valeur coincides
           If ObjRangeA.Value = ObjRangeB.Value Then
               'On memorise
               CelTrouve = True
               'on sort de la boucle car
               'inutile d'aller plus loin
               Exit For
           End If
       Next
       
       'Si la valeur n'as pas été trouve
       If Not CelTrouve Then
           'on l'ajoute à la collection
           On Error Resume Next
               'Si déjà ajouter erreur (mais ignorée)
               Call NiveCell.Add(ObjRangeA.Value, ObjRangeA.Value)
           On Error GoTo 0
       End If
   Next
   
   '==============================
   'A partir de la nous sommes capable de remplir la feuille
   'Numero de la ligne courante ou l'on écrit
   Dim idxLigne As Long
   idxLigne = 0
   'pour chaque valeur de la cellule souche
   For i = 1 To NiveCell.Count
       'on passe à la ligne suivante
       idxLigne = idxLigne + 1
       'on appelle la procédure de remplissage
       Call FillArbo(PElements(NiveCell(i)), idxLigne, 1)
   Next
End Sub<hr />

Private Sub FillArbo(IdxElem As Integer, ByRef NumRow As Long, ByRef NumCol As Long)
'Element temporaire
Dim TmpElement As Element
'variable de boucle
Dim i As Integer
'indice de l'élément dans le tableau PElement
Dim idx As Integer
   'Récuperation de l'élément d'incide idxElem
   TmpElement = Elements(IdxElem)
   'Ecriture du nom de l'élément dans la feuille destination
   ActiveWorkbook.Worksheets("Feuil2").Cells(NumRow, NumCol).Value = TmpElement.Nom
   'Pour chaque sous éléments
   For i = 0 To UBound(TmpElement.SousElements)
       'On gère le numéro de ligne
       NumRow = NumRow + i
       'on récupère l'indice (si il existe) de l'élement
       idx = HasChild(TmpElement.SousElements(i))
       'Si l'indice existe
       '=> on doit passer à un niveau plus bas
       If idx <> -1 Then
           '=> on rappelle donc la meme procédure mais avec des parametre différents
           Call FillArbo(idx, NumRow, NumCol + 1)
       Else
           'Sous élément UNIQUE (n'ayant lui même aucun sous element)
           'On remplit la feuille
           ActiveWorkbook.Worksheets("Feuil2").Cells(NumRow, NumCol + 1).Value = TmpElement.SousElements(i)
       End If
   Next
End Sub<hr />
'Cette fonction renvoi -1 si l'élément est unique
Private Function HasChild(strEleme As String) As Integer
   On Error GoTo HandleError
   'récupération de l'indice
   HasChild = PElements(strEleme)
   Exit Function
HandleError:
   'gestion d'erreur si l'élement cherche n'est pas
   'dans la collection de correspondance
   HasChild = -1

End Function<hr />

, ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
19
Je commencerais par trier tes colonnes (A comme premier paramètre, B comme 2e)
Ensuite, tu fais un filtre élaboré pour ressortir une valeur unique de chaque donnée de la colonne A que tu copies en C, disons.
À partir de là, tu fais une recherche sur chaque donnée issue de ce filtre élaboré
    et continue les recherches sur les données trouvées jusqu'à ce qu'il n'y en ait plus...

Une première idée comme ça... et sûrement pas la meilleure...

MPi
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
Salut,
Est ce que ton exemple est correct?

Car ceci:

Chaine3 Chaine4
Chaine3 Chaine7
Chaine1 Chaine2
Chaine1 Chaine3
Chaine6 Chaine5
Chaine6 Chaine3
Chaine5 Chaine4
Chaine5 Chaine7
Chaine7 Chaine8
Chaine7 Chaine9

Ne devrait il pas donné cela

<col style=\"width: 60pt;\" span=\"4\" width=\"80\" />----
Chaine1, Chaine2,
,
, ----

, Chaine3 , Chaine4,
, ----

,
, Chaine7, Chaine8, ----

,
,
, Chaine9, ----
Chaine6, Chaine5, Chaine4,
, ----

,
, Chaine7, Chaine8, ----

,
,
, Chaine9, ----

, Chaine3 , Chaine4,
, ----

,
, Chaine7, Chaine8, ----

,
,
, Chaine9

Au lieu de ce que tu ecrivais?

Chaine1 Chaine2
....... Chaine3 Chaine4
............... Chaine7 Chaine8
....................... Chaine9
Chaine6 Chaine5
....... Chaine3 Chaine4
............... Chaine7 Chaine8
....................... Chaine9

@+: Ju£i?n
Pensez: Réponse acceptée
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
19
Le tableau que ça me génère est celui-ci
<col style=\"width: 60pt;\" span=\"4\" width=\"80\" />----
Chaine3, Chaine7, Chaine8, , ----
, , Chaine9, , ----
, Chaine4, , , ----
Chaine1, Chaine2, , , ----
, Chaine3, Chaine7, Chaine8, ----
, , , Chaine9, ----
, , Chaine4, , ----
Chaine6, Chaine5, Chaine4, , ----
, , Chaine7, Chaine8, ----
, , , Chaine9, ----
, Chaine3, Chaine7, Chaine8, ----
, , , Chaine9, ----
, , Chaine4, , ----
Chaine5, Chaine4, , , ----
, Chaine7, Chaine8, , ----
, , Chaine9, , ----
Chaine7, Chaine8, , , ----
, Chaine9

Et pour y arriver, j'ai utilisé la récursivité
Tu peux utiliser Application.ScreenUpdating = false pour ne pas voir les données se copier
Le remettre à True à la fin

Option Explicit

Sub OnDémarreIci()
    Dim I As Integer
    Dim Ligne As Integer
    Dim Tablo()   'tableau qui contiendra les valeurs uniques (Colonne A)
   
    ReDim Tablo(0)
    Ligne = 1
   
    'Trouver les valeurs uniques
    For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If Not IsInTablo(Range("A" & I), Tablo) Then
            Tablo(UBound(Tablo)) = Range("A" & I)
            ReDim Preserve Tablo(UBound(Tablo) + 1)
        End If
    Next
   
    'Inscrire ces valeurs uniques en C, pour un départ
    For I = 0 To UBound(Tablo) - 1
        Range("C" & Ligne) = Tablo(I)
        Ligne = Ligne + 1
    Next
   
    InscrireDonnées 3   ' 3 étant l'index de la colonne à lire
   
End Sub

' Lecture de la dernière colonne inscrite
' Et écriture dans la colonne voisine de droite des données trouvées
Sub InscrireDonnées(Colonne As Integer)
    Dim I As Integer, Ligne As Integer
    Dim Recherche As Range, Adresse As String
   
    If Cells(Rows.Count, Colonne).End(xlUp).Row = 1 Then Exit Sub
   
    Ligne = 1
           
    For I = 0 To Cells(Rows.Count, Colonne).End(xlUp).Row
        If Cells(Ligne, Colonne) <> "" Then
            Set Recherche = Columns("A:A").Find(Cells(Ligne, Colonne))
            If Not Recherche Is Nothing Then
                Adresse = Recherche.Address
                Do
                   ' Insertion d'une ligne
                    Range("C" & Ligne + 1 & ":IV" & Ligne + 1).Insert xlShiftDown

                    Cells(Ligne, Colonne + 1) = Range(Recherche.Address).Offset(0, 1)
                    Ligne = Ligne + 1
                    Set Recherche = Columns("A:A").FindNext(Recherche)
                Loop Until Recherche Is Nothing Or Recherche.Address = Adresse

                ' Effacer la ligne en trop
                Range("C" & Ligne & ":IV" & Ligne).Delete xlShiftUp
            Else
                Ligne = Ligne + 1
            End If
        Else
            Ligne = Ligne + 1
        End If
    Next
   
    Colonne = Colonne + 1  ' tant qu'il y a des données, on lit la colonne suivante
               
    InscrireDonnées Colonne  'appel récursif
   
End Sub

'Fonction pour savoir si la valeur est déjà dans le tableau
Function IsInTablo(Valeur, Tablo) As Boolean
    Dim I As Integer
   
    For I = 0 To UBound(Tablo)
        If Tablo(I) = Valeur Then
            IsInTablo = True
            Exit For
        End If
    Next
End Function

MPi
Messages postés
6
Date d'inscription
vendredi 23 avril 2004
Statut
Membre
Dernière intervention
31 juillet 2007

Déjà, merci à tous les deux pour votre réponse détaillé et le temps que vous avez passé dessus :)

Ton code MPi ne donne hélas pas le bon tableau, qui est en fait celui donné par Julien dans le 2ème post :


Chaine1 Chaine2
Chaine3 Chaine4
Chaine7 Chaine8
Chaine9
Chaine6 Chaine5 Chaine4
Chaine7 Chaine8
Chaine9
Chaine3 Chaine4
Chaine7 Chaine8
Chaine9


Ton code Julien marche très bien, merci beaucoup !
Y a juste un petit souci : Il m'ajoute une ligne vide, puis deux, puis trois, etc lorsque la tableau d'entrée est plus long. Je vais essayer de corriger ça, mais merci encore :)
Messages postés
6
Date d'inscription
vendredi 23 avril 2004
Statut
Membre
Dernière intervention
31 juillet 2007

Mince je me suis loupé dans l'indentation du tableau de sortie, le revoici ( mais c'est bien celui donné par Julien dans le 3ème post ) :

Chaine1 Chaine2
....... Chaine3 Chaine4
............... Chaine7 Chaine8
....................... Chaine9
Chaine6 Chaine5 Chaine4
............... Chaine7 Chaine8
....................... Chaine9
....... Chaine3 Chaine4
............... Chaine7 Chaine8
....................... Chaine9
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
19
J'ai dû mal comprendre alors...
Chaîne1 devrait générer Chaîne3 qui génère chaîne7 qui génère chaînes 8 et 9 , non ?

MPi
Messages postés
6
Date d'inscription
vendredi 23 avril 2004
Statut
Membre
Dernière intervention
31 juillet 2007

Oui c'est bien ça, mais vu que Chaine3 est un "fils" ( c'est à dire qu'il est lui-même généré par Chaine1, autrement dit : Chaine3 se trouve dans la colonne B ), il ne doit pas se trouver en racine de l'arbre.
On doit donc seulement avoir Chaine1 et Chaine6 en racine, soit les deux seuls qui ne sont pas dans la colonne B.

C'est pas évident je sais :S