[VBA-Excel] Construction d'un arbre d'appelsRésolu

Question

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 !

jrivet · Accepted Answer

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

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

'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

, ---- [code.aspx?ID=41455 By Renfield] @+: Ju£i?n Pensez: Réponse acceptée

cs_MPi · Answer

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

jrivet · Answer

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

cs_MPi · Answer

Le tableau que ça me génère est celui-ci ---- 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

cs_FenX · Answer

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 :)

cs_FenX · Answer

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

cs_MPi · Answer

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

cs_FenX · Answer

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

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

8 réponses

Votre réponse

Discussions similaires