XL 2016 Arborescence/Récursivité (Transformation d'une arborescence en Base de Données)

[laurent950]

Bonjour Le Forum,

Sujet : Arborescence/Récursivité (Transformation d'une arborescence en Base de Données)

Je suis sur un sujet d'arborescence et de Récurcivité :
- J'ai pris l'idée sur le site de Boigontier
* http://boisgontierj.free.fr/
* Sujet : Arborescence/Récursivité
* Son Projet depuis le fichier (NomenclatureEnsemble) dont je m'en suis inspiré
* La base de données que j'ai retravaillée copié du fichier (TreeviewNomenclature)


Mon Travail :
Le Fichier Excel "ArborescenceRecurcivité_V0.xlsm" (ci-joint) est composé :
- 1_DocumentOrigineNonTransformé
° Nota : C'est le document original est à transformer (par VBA Uniquement)
- 4_ResultatFinalAobtenir
° Nota : C'est le résultat à obtenir (avec le Code VBA à créer)
- Laissé pour explication des étapes intermédiaire :
° Nota : Travail fait à la main pour la compréhension du résultat à Obtenir.
Architecture de transformation, Le cheminement :
- 2_FormuleLaisserPourComprendre
- Exemple-Formule-Comprehension-Du-Projet.JPG
et
Les Blocs à repéter :
- 3_ResultatIntemediaireAobtenir
- Exemple-Formule-Comprehension-Du-Projet_Détail Suplmentaire.JPG
- 5_orgaTexte (Hors sujet de travail)
a) PM : Boisgontier la mis sous forme d'arborescence
que j'ai laissé dans le classeur excel pour exemple du rendu en arborescence :
Sur la Feuille (5_orgaTexte)
' Module de @BOISGONTIER
Module VBA "ModTexte" du extrait du fichier NomenclatureEnsemble
de la page Arborescence/Récursivité
du site http://boisgontierj.free.fr/

Explication du travail :
° Je dois transformer le document d'origine pour le remettre sur un nouveau format :
b) Je souhaite le résultat à obtenir sur une seule Ligne :
Suivant le Modèle de la Feuille 4_ResultatFinalAobtenir

Je souhaite réaliser cette tâche uniquement avec le code VBA

J'ai laissé un maximum de détails pour arrivée directement de la feuille :
_ 1_DocumentOrigineNonTransformé (Données d'entrée)
_ 4_ResultatFinalAobtenir (Données Sortie)


J'ai essayé de détailler un maximum pour la compréhension, Je souhaite une procédure VBA uniquement en utilisant
le même principe de récursivité dont à utilisé Boigontier.

j'ai essayé d'adapter mais ce n'est pas encore cela je finalise et je compléterais cette fiche en Poste #1 pour le travail que
j'ai commencé à effectuer pour ce travail.

S'Il y des experts en Arbres / Arborescence / Récursivité pour m'aider à comprendre le concept de la récurcivité et surtout
l'organisation des variables qui sont complexes dans leur réutilisation.

Merci à tous ceux m'apportant des solutions.

Ps : Merci @BOISGONTIER pour tous vos précieux exemple.

Laurent

 

[Dranreb]

Ouais ben il ne faut pas de doublon, c'est tout. Le deuxième bloc devrait commencer par 2.2.1

 

[laurent950]

re @Dranreb

Pour La gestion de l'erreur dans le module Standard j'ai bien compris @Dranred ?
Celle qui gère le manque de l'arborescence comme dans l'exemple :
Repère Lignes Numéro : A7 et A61 (Manque N° Arborescence)

Puis Pour :

Ouais ben il ne faut pas de doublon, c'est tout. Le deuxième bloc devrait commencer par 2.2.1

Oui Justement y a t'il une méthode pour vérifiée la cohérence de l'arborescence en amont ?
j'ai généré cette erreur exprès pour l'exemple.

Et Oui il ne faut pas de doublon chaque ligne renseigné à un numéro unique, je suis d'accord avec vous

sauf que si il y a une erreur alors comment naviguer dans le code pour si retrouver dans les exemplaires ?
Dans une variables tableau je sais faire mais alors dans la variable global "RubGlobale" Alors là je sais vraiment plus faire ?

 

[Dranreb]

Tout ce que je vois c'est une vérification possible :

Property Let Txt(ByVal Texte As String)
' Ecriture dans la Classe
   If LeTexte <> "?" And Txt <> LeTexte Then
      Select Case MsgBox("Texte """ & LeTexte & """ déjà attribué." _
         & vbLf & "Voulez vous le remplacer par """ & Txt & """ ?", vbExclamation, vbYesNoCancel)
         Case vbNo: Exit Property
         Case vbCancel: End: End Select
   LeTexte = Texte ' .................................. Inscription du Texte qui correspondant au "NUMERO DE L'ARBORECENSE" afin de le stocké dans l'exemplaire du module de classe
   End Property

 

[laurent950]

Je voulais aussi savoir, pour le travail de compréhension que j'ai fais sur votre code, en rapport avec mes commentaires en face des variables et lignes de votre code cela vous semble cohérent et correcte ?

Y a t'il des endroit ou je me suis mélangé ou mal compris, j'ai essayé au mieux j'y ai passé vraiment du temps !

Votre avis m'intéresse a ce sujet de compréhension du code ?

 

[Dranreb]

Les Set SsRub = SsRub.Item(TSpl(P)) ne me semblent pas clairs. Plutôt ' Réinitialise SsRub comme prochaine rubrique à considérer, trouvée dans celle du niveau précédent, un truc comme ça …

 

[laurent950]

Les Set SsRub = SsRub.Item(TSpl(P)) ne me semblent pas clairs. Plutôt ' Réinitialise SsRub comme prochaine rubrique à considérer, trouvée dans celle du niveau précédent, un truc comme ça …

Dans mon esprtit
C'est comme ci le "Set SsRub" est écraser par le nouveau SsRub.Item(TSpl(P))
Comme ci j'ai cela
Dim Feuille as Worksheet
set Feuille = Worksheets("Feuille Base de donner")
Msgbox Feuille.Name ' Feuille Base de donner
set Feuille = Worksheets("Feuille Resultat")
Msgbox Feuille.Name ' Feuille Resultat

J'écrase l'ancienne adresse par la nouvelle
Vrai Ou Faux ?

 

[Dranreb]

Oui c'est cela.

 

[Dranreb]

On peut peut être ajouter une propriété Chapitres en lecture seule :

Option Explicit
Private LaParente As Rubrique, LesChapitres As String, LeTexte As String, CLn As Collection
Private Sub Class_Initialize()
   Set CLn = New Collection
   End Sub
Public Sub Init(ByVal Owner As Rubrique, ByVal Chapitres As String)
   Set LaParente = Owner
   LesChapitres = Chapitres
   End Sub
Public Function Item(ByVal Rub As String) As Rubrique
   On Error Resume Next
   Set Item = CLn(Rub)
   If Err Then
      Set Item = New Rubrique
      Item.Init Me, LesChapitres & "." & Rub
      Item.Txt = "?"
      CLn.Add Item, Rub: End If
   End Function
Function Parent() As Rubrique
   Set Parent = LaParente
   End Function
Function Chapitres() As String
   Chapitres = Mid$(LesChapitres, 2)
   End Function
Property Let Txt(ByVal Texte As String)
   If LeTexte <> "?" And Texte <> LeTexte Then
      Select Case MsgBox("Texte """ & LeTexte & """ à" & vbLf & "remplacer par """ _
         & Texte & """ ?", vbExclamation + vbYesNoCancel, "Rubrique " & Chapitres)
         Case vbCancel: End
         Case vbNo: Exit Property
         End Select
      End If
   LeTexte = Texte
   End Property
Property Get Txt() As String
   Txt = LeTexte
   End Property

 

[laurent950]

Re @Dranred

J'ai saisie votre logique :
J'avais cette Idée
Stocké les Numéros des Arborescences
* Dans le Module standard ce serait cette ligne :

° SsRub.Txt = TDon(LD, 1) ' ........................... Envois Le Numéro d'arborescence "TDon(LD, 1)" qui correspondant au "NUMERO DE L'ARBORECENSE" ---->>> VERS l'exemplaire du module de classe

Alors dans le Module de Classe :
Créer une variable tableau 1 dimension
Private TabLesChapitres() As String
---------------------------------------------------------------------------------------------------
Il faudrait la dimensionner la variable TABLEAU dans la classe initialise :
Private Sub Class_Initialize()

Avec une condition pour pas la redimensionner a chaque fois mais une seule fois.
si la variable tableau est vide alors
Redim TabLesChapitres(0)
et fin

---------------------------------------------------------------------------------------------------------

puis dans :
Public Function Item(ByVal Rub As String) As Rubrique
quand on rentre dans la condition
Redim Preserve TabLesChapitres(Ubound(TabLesChapitres))

-----------------------------------------------------------------------------------------------------------

Puis dans cette procédure : Property Let Txt(ByVal Texte As String)

On Fait une Boucle qui recherche les doublon
For i = Lbound(TabLesChapitres) to Ubound(TabLesChapitres)
For j = 1 to Ubound(TabLesChapitres)
If TabLesChapitres(i) = TabLesChapitres(j) then
flag = True
end if
next j
Next i
If flag = True then
LeTexte = "Doublon sur le Numéro de d'arborescence"
Else
LeTexte = Texte
end if

L'idée et de faire une fonction pour retrouvé les doublon sur les clefs (Numéro d'Arborescence)

------------------------------------------------------------------------------------------------------------

Je ne sais pas faire le teste sur une variable Tableau Vide ?
Le soucis c'est l'initialisation de la classe qui écrase à chaque fois la variable tableau

A moins de stocké cette Variable Tableau dans une classe et l'encapsuler dans une variable Collection

Créer un Objet de la Classe Rubrique
Créer une Variable Tableau
La dimensionné
La Stocké dans une Variable Collection
Puis cette Réutilisé cette Variable collection / Récupérer la Classe / La variable Tableau / Travailler avec Puis l'encapsuler a Nouveau etc?

Deux Idées différente mais un début

@Dranred, c'est en Vrac mes idées mais voila a quoi je pense avec ce que je viens d'apprendre.

L'idée c'est de laissé l'erreur se générer dans la restitutions de la base de donnée, Ensuite en Relecture voir qu'il y a une Erreur (Avec la Ligne Noté avec Le Numéro en d'arborescence en Doublon"
Le texte est simple : Erreur sur l'intitulé le Numéro [°°°°] est en Doublon !

Voila ou j'en suis

Un Grand Merci @Dranreb

 

[Dranreb]

Bof, la propriété Chapitres rend toute la chaine des rubriques séparées par des points

 

[Dranreb]

Je joins le classeur actuel

 

[laurent950]

@Dranreb

Déjà Mille merci pour toute ces explications, je vais faire des testes pour voir comment cela s'articule, j'aurais des idées et je reviens vers vous. Il y a de la matière à travailler avec cette exemple qui est riche pour travailler avec les Modules de classe, Vos Module de Classe qui sont Extra

je vais vous souhaité une bonne nuit @Dranreb et je reviens vers vous demain.

Laurent

 

[Dranreb]

Bonjour.
Ce coup-ci je crois que je vais arriver à griller vos neurones
Ajouté à Rubrique une méthode Parcourir et une propriété Suivante qui est … récursive !

 

[laurent950]

Bonjour @Dranreb

Poste #43 : se que je comprend
Parcourir :
Pos est égale à la clef de la collection qui stocke de l'exemplaire de la classe :
cln = la collection qui stock l'exemplaire de la classe
Pos = la clef qui donne Access à cette classe.
Set Suivante = CLn(Pos)

Suivante :
C'est effectivement la récursivité :
Imaginons Chapitre 1 / 2 / 3 / 4
'
Votre premier Objet :
* RubGlobale contient la première collection Cln (Initialisé au tous début quand on rentre dans la classe)
'
Puis selon votre code : SUIVANTE
'
Cette ligne (ci-dessous du Module Standard) Stock que les Têtes de Chapitres uniquement.
Set SsRub = RubGlobale.Item(TSpl(0)) ' Imaginons Chapitre 1 / 2 / 3 / 4
Cette ligne autres ligne (ci-dessous du Module Standard) Stock que les Sous Chapitres uniquement.
Set SsRub = SsRub.Item(TSpl(P))
'
Fonction suivante :
Redescendre toutes l'Arborescence du Point de départ au Point final.
Je pourrais imager un déplacement dans cette arborescence en retrouvant les bonnes positions (un peux comme avec un Offset Excel... les Positions pour ce déplacer, sont les même que fonction suivante se déplace dans l'arborescence avec avec les positions Pos
C'est comme avec Execl et Offset (Quand on a trouver la cellule ont sait ce qu'il y a dedans) et vous avec ce numéro position vous savez ce qu'il y a dans l'exemplaire (Stocké dans Cln).

Exemple pour : 3.5.7.4
Chapitre 3 (Facile c'est le Numéro 3)
Set Suivante = CLn(Pos) = Ici Pos sera égale à 3
'
Ensuite (Comme l'idée du Offset d'Excel) il faut redescendre cette Arborescence :
Dans Suivante il y a encore beaucoup d'autres Objets Cln qui contiennent des exemplaires de classe.
Donc pour passé à l'objet suivant :
il faut passé à l'exemplaire encapsuler / soit Set Suivante = Suivante.Suivante
Ect.
Votre code dans suivante avec les diverses condition permette cela
Je ne sais pas encore comment cela fonctionne mais j'ai compris le principe

Se que je vois en tous premier abord, c'est qu'il y a une logique avec les numérotations et les positions Pos pour retrouver les clefs des Collections qui stock les exemplaires.

Si les clefs des Collections était différentes : Exemple : CLn(A) / CLn(TT) / CLn(Paris) Enfin clef différente se serait peut être différent.

Mais avec cette logique de Numérotation d'Arborescence :
J'ai essayé d'expliquer comme j'ai pu. j'ai un début d'idée... Votre code c'est comme une gare de triage avec plein de voies ferrés et d'aiguillages de partout c'est pas si simple de tous conceptualisé... et de parcourir les chemins virtuellement pour arrivé à la collection qui contient le bon exemplaire... mais j'ai compris que vous redescendez l'arborescence puis remonter... Puis redescendez ( avec une gestion par niveau)

Vous en pensez quoi @Dranred il y a un début de compréhension (Je sais pas expliqué exactement) mais il y a un principe déjà que je comprend... j'ai juste a tester votre code Suivante... et comprendre toute la logique... comme cette exemple :
3.5.7.1
3.5.7.2
3.5.7.3
3.5.7.4
Je sais que : Set Suivante = LaParente.Suivante (C'est l'arborescence terminal 3.5.7.4)
Ensuite il faut remonté d'un Niveau si il existe avec votre code
3.5.8.1
3.5.8.2
Voila l'idée déjà

Merci @Dranreb

 

[Dranreb]

Bonjour.
Oui, il y a une certaine compréhension.
C'est plutôt moi, j'ai l'impression, qui en ai manqué, et ai de ce fait programmé une certaine absurdité.
En effet il semble qu'il n'y a nul besoin que la propriété Suivante soit récursive puisqu'elle renvoie déjà une Rubrique enfant, et que la fois d'après c'est d'elle qu'on demandera la suivante. Ce qu'il faut garder c'est cette espèce de récursivité inverse consistant à renvoyer LaParente.Suivante quand il n'en reste plus à la génération considérée.
En tout cas la méthode et la propriété réécrites comme ça semble marcher tout aussi bien :

Public Sub Parcourir()
   Pos = 0
   End Sub
Public Function Suivante() As Rubrique
   Dim SsRub As Rubrique
   Pos = Pos + 1
   If Pos <= CLn.Count Then
      Set Suivante = CLn(Pos)
      Suivante.Parcourir
   Else
      If LaParente Is Nothing Then Exit Function
      Set Suivante = LaParente.Suivante
      End If
   End Function