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

laurent950 · 22 Juillet 2021

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 · 23 Juillet 2021

Oui, j'ai vu, il faut mettre toute la 1ère boucle dans un bloc If TDon(LD, 1) <> "" Then

laurent950 · 2 Août 2021

Donc Voila ou j'en suis :

Dans mon code exemple pour cette propriété Parent de la classe Person je ne sais pas comment utilisée (En 1 Instancier L'objet Parent et ensuite en 2 L'utiliser) mais surtout en 1 L'instancier et entrer dans la condition.

Je pense que ce qui ne va pas du tout dans votre propriété Parent c'est cela :
Dans la Classe Person :
* il manquait cela
- Private mobjParent As Persons

J'ai ajouter l'Option Explicit partout.

Suivant Votre indice : Un indice: les instructions Property sont spécifiées comme transférant des objets, j'ai ajouter cela en Tête de Module Person (Private mobjParent As Persons)

Par contre c'est justement cela que je sais pas faire fonctionner :
* ce que vous me dite or les instructions qu'elles contiennent échangeraient au mieux des propriétés par défaut, or il n'en existent pas et il n'y a pas de moyen simple d'en définir, et j'ai mal reconstruit le code je pense !

Comment entrer dans cette ligne de Code

VB:

'Propriété Parent
Property Set Parent(ByRef objPersons As Persons)
If objPersons Is Nothing Then
' **********************************************************************************
' Ici Impossible de rentrer dans cette condition et d'instancier cette Objet
mobjParent = objPersons
' **********************************************************************************
End If
End Property

Dans le cour il y a cette Objet "Parent" et l'exemple aussi, mais je ne sais pas comment faire pour utiliser cela et le faire fonctionner.

J'ai essayer de reconstruire au mieux cet exemple, mais j'ai du faire une erreur quelque part. mais je ne vois pas ou ?

Comment faire Pour l'instancier cette Objet @Dranred

laurent950 · 2 Août 2021

Une correction

Private mobjParent As Persons

'Propriété Parent
Property Set Parent(ByRef objPersons As Persons)
If objPersons Is Nothing Then
Set mobjParent = objPersons
End If
End Property

Property Get Parent() As Persons
Set Parent = mobjParent
End Property

Dranreb · 2 Août 2021

Ah voilà !! Vous voyez quand vous voulez …

laurent950 · 2 Août 2021

Oui j'ai vu super déjà une avancé

Puis maintenant la grande question ?

a quoi sert cette ligne dans le Module (si c'est impossible de rentrer dans la condition ?
en Poste #17

Set objPerson.Parent = Me

VB:

Public Sub Add(ByRef objPerson As Person, _
                    Optional ByVal Key As String = "")
'Si aucune clé key n'est fournit on en génère une automatiquement
    If Len(Key) = 0 Then
        Key = objPerson.NomComplet & Format(objPerson.DateNaissance, "yyyymmdd")
    End If
    mcolPersons.Add objPerson, Key
    'l'objet est inséré dans la collection on automatiquement renseigne la propriété Parent
    ' *******************************************************************************************
Comment entrer dans la condition en Poste #17    
Set objPerson.Parent = Me
    ' ******************************************************************************************
    Set objPerson = Nothing
End Sub

La Franchement je n'y arrive pas ? Comment interpréter se cour avec le code que je n'arrive pas a faire fonctionner !

Dranreb · 2 Août 2021

Ben elle initialise la propriété Parent du Person comme étant le Persons lui même qui exécute ce code. Dans tous les modules objets Me représente toujours l'exemplaire sur lequel le code s'applique.

laurent950 · 2 Août 2021

Dranreb à dit:
Ben elle initialise la propriété Parent du Person comme étant le Persons lui même qui exécute ce code.

Je suis toute a fait d'accord mais avec le code dans le module Standard c'est impossible de rentrer dans la condition et d'initialisé cette variable "mobjParent" (dans ce Module de Classe).

car objPersons n'est jamais Nothing
donc :
Comment faire l'exemple pour que cet Objet soit à Nothing ?
Pour avoir l'exemple quand il est initialisé en le faisant entrer dans la condition ?
Comment écrire l'exemple ?

'Propriété Parent
Property Set Parent(ByRef objPersons As Persons)
If objPersons Is Nothing Then ' Cette Objet "objPersons" est Nothing
set mobjParent = objPersons ' Je suis dans la condition
End If
End Property

Comment faire l'exemple depuis le module standard pour entrer dans cette condition ?

Dranreb · 2 Août 2021

Ce test est absurde à mon avis. Faites simplement systématiquement Set mobjParent = objPersons

laurent950 · 2 Août 2021

Dranreb à dit:
Ce test est absurde à mon avis. Faites simplement systématiquement Set mobjParent = objPersons

Dranred j'ai vraiment suivit ce cour, si il est absurde c'est aussi normal que je me perde dans toute ces explication (du cour) et grâce a vos explication j'y mes de l'ordre.

Je vais essayé de corriger. comme vous m'avez dit

laurent950 · 2 Août 2021

Solution :

VB:

'Propriété Parent
Property Set Parent(ByRef objPersons As Persons)
    'If objPersons Is Nothing Then
        Set mobjParent = objPersons
    'End If
End Property

Bon enfin avec votre aide, et je vous remercie encore et encore Dranred, je suis arrivé à finalisé cette étape.

Un Grand Merci Dranreb.

laurent950 · 2 Août 2021

J'aimerais travailler sur le code du Poste #12 (Votre Code @Dranreb )

Puis y ajouter la Propriété parent.
Comme vous m'avez suggérer dans la conversation :
Le plus simple c'est de prévoir pour l'objet fils une méthode Init avec un 1er argument ByVal Owner As TypeDuParent pour lequel celui ci transmettra simplement Me. Il ne restera plus qu'à y faire Set Parent = Owner

C'est pour apprendre aussi et mettre en œuvre ce que j'ai appris et apprendre en même temps:
Car justement, j'ai tendance à raisonnez plutôt en terme de position dans le code, mais pas sur quel exemplaire le code travaille.

Pour des compléments (puis pour apprendre aussi) :
En complément du code Poste #12 j'ai penser à une présentation de l'arborescence, et pour cela consigner les positions (dans le module de classe) afin de recréer une arborescence.

Je remercie aussi @patricktoulon qui m'a aidé à comprendre le principe de récursivité sur son Poste #5 et #7

votre Code en poste #12 @Dranred qui est vraiment très très bien, Je vous remercie @Dranred de votre patience et de vos explication qui sont d'une grande précision

laurent

Dranreb · 3 Août 2021

C'est sûr une collection ne permet pas de retrouver les clés. Pour ce faire il faut qu'elles soient notées dans les membres. La propriété Parent ne semble toujours pas nécessaire mais prévoyons la à tout hasard.
Par contre pour retrouver l'arborescence, là il faudra peut être une procédure récursive. En attendant ces aménagement du module de classe Rubrique ne paraissent pas gêner l'actuelle Sub ConcatDésign :

VB:

Option Explicit
Private LaParente As Rubrique, LaClé 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, Rub As String)
   Set LaParente = Owner
   LaClé = Rub
   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, Rub
      Item.Txt = "?"
      CLn.Add Item, Rub: End If
   End Function
Function Parent() As Rubrique
   Set Parent = LaParente
   End Function
Function Rub() As String
   Rub = LaClé
   End Function
Property Let Txt(ByVal Texte As String)
   LeTexte = Texte
   End Property
Property Get Txt() As String
   Txt = LeTexte
   End Property

laurent950 · 3 Août 2021

Bonsoir @Dranreb

Partie 1 Compréhension du code (avec commentaire)
J'ai compris en grande partie le code et j'ai tous commenté :

Votre Module de Classe "Rubrique" (Ci-dessous)

VB:

Option Explicit
Private LaParent As Rubrique ' .......................... Variable Privé de Type "Rubrique"
Private LeTexte As String ' ............................. Variable Privé de Type "Integer"
Private CLn As Collection ' ............................. Variable Privé de Type "Collection"
Private LaClé As String ' ............................... Variable Privé de Type "String" (Clé de la collection)
Private Sub Class_Initialize()
' Initialisation de la Classe.
   Set CLn = New Collection ' ........................... Instatiation de la Variable Cln du Type Collection.
End Sub
Public Sub Init(ByVal Owner As Rubrique, Rub As String)
    Set LaParent = Owner ' .............................. Inscription de : L'EXEMPLAIRE DU MODULE DE CLASSE EN COUR dans la variable PRIVE "LaParent"
    LaClé = Rub ' ....................................... Inscription du : NUMERO       DU MODULE DE CLASSE EN COUR dans la variable PRIVE "LaClé"
End Sub
Public Function Item(ByVal Rub As String) As Rubrique
  On Error Resume Next
   Set Item = CLn(Rub) ' ............................... RENVOIS L'EXEMPLAIRE DU MODULE DE CLASSE QUI EST STOCKE (dans l'objet Collection "Cln" Via sa Clé "Rub") --->> Afin de l'Utiliser
     If Err Then ' ..................................... Si Erreur Alors ---->>>   L'objet "Cln" NE CONTIENT PAS D'EXEMPLAIRE du MODULE DE CLASSE (Cf Ligne : Ci-Dessus)
       Set Item = New Rubrique ' ....................... Alors il y a la CREATION d'un Objet "Item" de Typé du MODULE DE CLASSE "Rubrique"
       Item.Txt = "?" ' ................................ Enregistrement Provisoir d'un Texte "?"
       CLn.Add Item, Rub ' ............................. Ajout dans l'Objet Collection "Cln" L'Objet (Item = l'exemplaire de la classe en cour) avec ca Clé "Rub" / Qui Permetra d'utilisé cet Objet par la suite.
      End If
  On Error GoTo 0  ' ................................... Fin de la Gestion des Erreurs !
   End Function
Function Parent() As Rubrique
    Set Parent = LaParent ' ............................
End Function
Function Rub() As Rubrique
    Rub = LaClé ' ......................................
End Function
Property Let Txt(ByVal Texte As String)
' Ecriture dans la Classe
   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
Property Get Txt() As String
' Lecture dans la Classe
   Txt = LeTexte ' .................................... Restitution de l'inscription du Texte qui correspondant au "NUMERO DE L'ARBORECENSE" stocké dans l'exemplaire du module de classe ---->>> VERS Le Module Standard
   End Property

Votre Module Standard "Module1) (Ci-Dessous)

VB:

Option Explicit
Sub ConcatDésign()
' Déclaration des Variables
' Passage 1 : Récupération de la structure de l'Arorecense.
   Dim RngDon As Range ' ..................................... Plage de cellule à traiter (A2:Fxx) = Nombre de Ligne Par Nombre de colonne
   Dim TDon() As Variant ' ................................... Variable Tableau de Type "Variant" qui contient la plage de valeur = ((Ligne Début/ Colonne Fin) de la plage à traiter "RngDon")
   Dim LD As Long ' .......................................... Variable de Type "Long" Compteur du Nombre de lignes du le Tableau 2D "TDon"
   Dim TSpl() As String ' .................................... Variable de Type "String" qui contient le découpage de la Chaine au "." dans le Tableau 1D "TSpl"
' Variable de Module de Classe : "Rubrique"
   Dim RubGlobale As New Rubrique ' .......................... La Variable "RubGlobale" est INSTANCIER des sa création "As New" "Objet "RubGlobale" Associé à Cln Collection Stocké dans la classe Rubrique"
   Dim SsRub As Rubrique ' ................................... La Variable "SsRub" est NON INSTANCIER "Objet "SsRub" Associé à Cln Collection Stocké dans la classe Rubrique"
'    * Astuce Dranreb : Il y a deux Objet Cln différents stocké dans deux Exemplaires de Classe
'       ° RubGlobale (Les chaptres : 1 / 2 / 3 / 4 Ect
'       ° SsRub      (Les Sous Capitres : 1.1 / 1.2 / 1.3 / 1.4 Etc.
' Passage 2 : Restitution de la structure de l'Arorecense en BASE DE DONNEES
   Dim TRés() As Variant ' ................................... Variable de Type "Variant" contenant le Résultat sous forme de Base de Donnée (Ligne Début/ Colonne Fin) sans Ligne vide dans le Tableau 2D "TRés".
   Dim LR As Long ' .......................................... Variable de Type "Long" Compteur du Nombre de lignes du le Tableau 2D "TRés"
   Dim P As Integer ' ........................................ Variable de Type "Integer" Compteur du Nombre de découpage de la chaine au "." du Tableau 1D "TSpl"
   Dim C As Integer ' ........................................ Variable de Type "Integer" Compteur du Nombre de colonne a récupérer en désignation Finale du Tableau "TDon"
' Passage 1 : Annalyse de la structure de l'Arorecense
'           : Et Stockage des données dans les exemplaires
   Set RngDon = PlgUti(Feuil1.[A2]) ' ........................ Feuil1 = 1_DocumentOrigineNonTransformé / Envois cellule (A2)
   TDon = RngDon.Value ' ..................................... Contient la Plage Range (Ligne Début/ Colonne Fin) qui est Transferé dans une Variable tableau "TDon" de Type "Variant"
   For LD = LBound(TDon, 1) To UBound(TDon, 1) ' ............. Boucle sur les (Ligne Début/ Ligne Fin) du Tableau "TDon"
      If TDon(LD, 1) <> "" Then ' ............................ Si La case (Ligne LD/ Colonne 1) du Tableau "TDon" est VIDE ont passe à la Ligne Suivante
         TSpl = Split(TDon(LD, 1), ".") ' .................... Si La case (Ligne LD/ Colonne 1) du Tableau "TDon" est NON VIDE (Découpage de la Chaine a chaque changement de ".")
         ' Les chapitres "RubGlobale"
         Set SsRub = RubGlobale.Item(TSpl(0)) ' .............. Envois dans la Function de la Classe Rubrique avec "RubGlobale" (Le Numéro CHAPITRE "TSpl(0)" de l'Arborescence : Exemple 1.5.6.3 Soit "Chapitre = 1)
           ' Les Sous Chapitre "SsRub"
           For P = 1 To UBound(TSpl) ' ....................... Envois dans la Function de la Classe Rubrique (Les Numéros des SOUS CHAPITRE "TSpl(1)/TSpl(2)/Etc." de l'Arborescence : Exemple 1.5.6.3 Soit "SOUS CHAPITRE = 5/TSpl(1) et SOUS SOUS CHAPITRE = 6/TSpl(2) et et SOUS SOUS CHAPITRE = 3/TSpl(3)... Ect
           ' Les Sous Chapitre "SsRub"
             Set SsRub = SsRub.Item(TSpl(P)) ' ............... Envois dans la Function de la Classe Rubrique avec "SsRub"(Les Numéros des SOUS CHAPITREs "TSpl(1)/TSpl(2)/Etc." de l'Arborescence : Exemple 1.5.6.3 Soit "Sous Chapitre = 5 et Sous Sous Chapitre = 6 et Sous Sous Sous Chapitre = 3 )
           Next P
         SsRub.Txt = TDon(LD, 2) ' ........................... Envois du Texte "TDon(LD, 2)" qui correspondant au "NUMERO DE L'ARBORECENSE" ---->>>  VERS l'exemplaire du module de classe
      End If
 
   Next LD
' Passage 2 : Restitution de la structure de l'Arorecense en BASE DE DONNEES
'           : Stockage des données
   ReDim TRés(1 To UBound(TDon, 1), 1 To 6)
   For LD = LBound(TDon, 1) To UBound(TDon, 1) ' ............. Boucle sur les (Ligne Début/ Ligne Fin) du Tableau "TDon"
     If Not IsEmpty(TDon(LD, 3)) Then ' ...................... Si sur la (Ligne LD/ Colonne 4) du Tableau "TDon" Il y a une Quantité on Entre dans La condition !
       LR = LR + 1 ' ......................................... Compteur pour Remplissage de la Variable Tableau "TRés" Soit LR = LR + 1 Soit "Les Lignes du résultat trouvé à Remplir dans la Variable Tableau"
       TSpl = Split(TDon(LD, 1), ".") ' ...................... (Ligne LD/ Colonne 1) du Tableau "TDon" (Découpage de la Chaine a chaque changement de ".")
       Set SsRub = RubGlobale
         For P = LBound(TSpl) To UBound(TSpl) - 1 ' .......... Boucle sur le Tableau 1D "TSpl" DE L'ARBORESCENCE (Désignation "Pére") : Exemple 1.5.6.3 Soit "TSpl(0)=1/TSpl(1)=5/TSpl(2)=6/"
           Set SsRub = SsRub.Item(TSpl(P)) ' ................. Appelle de l'exemplaire de la classe ou est stocké le texte de la désignation
           TSpl(P) = SsRub.Txt ' ............................. Substitution du Numéro de la CORRESPONDANCE de l'exemplaire (Pour Rappel LaClé "Rub" Par la Désignation.
         Next P
       ' Reconstitution de la Base de Donnée dans le Tableau 2D "TRés"
         TRés(LR, 2) = SsRub.Item(TSpl(UBound(TSpl))).Txt ' . Appelle de l'exemplaire de la classe ou est stocké le texte de la désignation Désignation (Fils = UBound(TSpl))
       ' * Astuce "ReDim Preserve" Pour Joindre "TSpl" SAUF LA DESIGNATION (Fils)
         ReDim Preserve TSpl(UBound(TSpl) - 1)
         TRés(LR, 1) = Join(TSpl, " - ") ' ................... Join les Cases du Tableau "TSpl" de la (Désignation "Pére" --->>> Racine de cette ARBORECENSE : Exemple 1.5.6.3 Soit "1-5-6" en Ligne LR de la Colonne 1 du Tableau "TRés"
         For C = 3 To UBound(TRés, 2) ' ...................... Boucle pour remplir la Ligne LR Pour les Colonnes du tableau 2D "TRés" (3 "U" / 4 "Quantité" / 5 "PU" / 6 "MT")
           TRés(LR, C) = TDon(LD, C) ' ....................... "C = N°Colonne TRés" / Complément C=3 "U" / C=4 "Quantité" / C=5 "PU" / C=6 "MT"
         Next C
     End If
   Next LD
   Feuil2.[A2:G10000].ClearContents ' ...................... Nettoyage de valeurs de la feuille
   Feuil2.[B2:G2].Resize(LR).Value = TRés ' ................ Copie le Tableau "Trés" dans la Feuille
   Feuil2.[A:G].Columns.AutoFit ' .......................... Ajuste automatiqumement les largeurs de colonnes "en rapport avec la longueur des Textes"
   End Sub
Function PlgUti(ByVal PlageDép As Range, Optional ByVal PlagExam As Range = Nothing, _
   Optional ByVal LMin As Long, Optional ByVal CMin As Long) As Range
Rem. ——— Plage renseignée de plus qu'une chaîne vide à partir de PlageDép dans PlageExam assumé UsedRange si non précisé.
Rem. ——— PlgUti (Syntaxe) : PlgUti(Cells de départ Exemple : A2, [ Plage Connue Exemple : A2:F1226 ], [ Derniére Lig Connue : Exemple : 1226], [ Derniére Lig Colonne : Exemple : 6 ])
 ' Déclaration des Variables
   Dim LMax As Long '............................... Nombre de lignes (Derniére non Vide Colonne A de la Feuille)
   Dim CMax As Long '............................... Nombre de Colonnes (Derniére non Vide Ligne 1 de la Feuille)
   Dim NbL As Long  '............................... Nombre de lignes (Réel de la matrice à traité / Début & Fin du Bordereau)
   Dim NbC As Long  '............................... Nombre de Colonnes (Réel de la matrice à traité / Début & Fin du Bordereau)
'
On Error GoTo RienTrouvé
' Propriété Worksheet.UsedRange : Renvoie un objet Range qui représente la plage utilisée dans la feuille de calcul spécifiée. En lecture seule.
   If PlagExam Is Nothing Then Set PlagExam = PlageDép.Worksheet.UsedRange
   ' PlagExam = Plage de données Range.
'
   LMax = PlagExam.Find("*", PlagExam.Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
   CMax = PlagExam.Find("*", PlagExam.Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column
On Error GoTo 0
   NbL = LMax - PlageDép.Row + 1: If NbL < LMin Then NbL = LMin
   NbC = CMax - PlageDép.Column + 1: If NbC < CMin Then NbC = CMin
'
   If NbL < 1 Or NbC < 1 Then GoTo CEstToutVide
'
   Set PlgUti = PlageDép.Resize(NbL, NbC) '............................... Plage de la Matrice borné à traiter.
   Exit Function

RienTrouvé: Resume CEstToutVide
CEstToutVide: Set PlgUti = Nothing
   End Function

Laurent

laurent950 · 3 Août 2021

Re @Dranreb

J'ai modifier votre code initial (Module Standard) pour le Résultat sur la "Feuil = Résultat obtenu"
Les 6 Colonnes sont décomposé comme suit (ci-Dessous)
Exemple si N° Arborescence 1.5.6.3
° 1 Désignation (Père) Soit 1.5.6
° 2 Désignation (Fils) Soit 3
° 3 U
° 4 Quantité
° 5 PU
° 6 MT

Voila comment le résultat est Obtenu a partir de la Ligne :
° Passage 2 : Restitution de la structure de l'Arborescence en BASE DE DONNEES
: Stockage des données
* ----------------------------------------------------------------------------------------------------
* Ce que j'ai Modifié dans le Module Standard
ReDim TRés(1 To UBound(TDon, 1), 1 To 6) ' Ajout d'une colonne
For LD = LBound(TDon, 1) To UBound(TDon, 1) '
If Not IsEmpty(TDon(LD, 3)) Then
LR = LR + 1
TSpl = Split(TDon(LD, 1), ".")
Set SsRub = RubGlobale
For P = LBound(TSpl) To UBound(TSpl) - 1 ' Sauf dernière case = Désignation (Fils) : Soit 3
Set SsRub = SsRub.Item(TSpl(P))
TSpl(P) = SsRub.Txt
Next P
' Reconstitution de la Base de Donnée dans le Tableau 2D "TRés"
TRés(LR, 2) = SsRub.Item(TSpl(UBound(TSpl))).Txt ' Désignation (Fils) : Soit 3
Pour Eviter de joindre la derniére case "TSpl = Désignation (Fils) : Soit 3"
Je la supprime avec redim Preserve
ReDim Preserve TSpl(UBound(TSpl) - 1)
TRés(LR, 1) = Join(TSpl, " - ")
Je copie les Colonnes (3/4/5/6)
For C = 3 To UBound(TRés, 2)
TRés(LR, C) = TDon(LD, C)
Next C
End If

J'ai des questions @Dranreb :
Question N° 1 :
Vous dite : C'est sûr une collection ne permet pas de retrouver les clés
Vous Expliquer la démarche : Pour ce faire il faut qu'elles soient notées dans les membres.
Moi : Comment faire cela dans le code ?
et aussi : notées dans les membres (A qu'elle endroit "Ou et Comment ?)

Question N°2 :
Vous dite : Par contre pour retrouver l'arborescence, là il faudra peut être une procédure récursive
Moi : Comment faire cela dans le code ?

Suite au code actuel :
J'ai générer 2 Types d'erreurs sur le fichier Excel ci-joint :

A) Oublies de Numérotation d'Arborescence :

Comme on test la colonne U (Si elle est non vide on entre dans la condition)
Alors c'est normal que si le Numéro n'existe pas cela crée une Erreur
Avant de coder, je vous montre en Image
Puis
Je joins le bout de code (mais pas sur que cela soit bien dans l'esprit du Module de Classe)
* Repère Lignes Numéro : A7 et A61 (Manque N° Arborescence)
Solution pour gérer cette erreur !

Code:

         Je peux ajouter cela dans le code !
         On Error Resume Next
       ' Reconstitution de la Base de Donnée dans le Tableau 2D "TRés"
         TRés(LR, 2) = SsRub.Item(TSpl(UBound(TSpl))).Txt ' . Appelle de l'exemplaire de la classe ou est stocké le texte de la désignation Désignation (Fils = UBound(TSpl))
       ' * Astuce "ReDim Preserve" Pour Joindre "TSpl" SAUF LA DESIGNATION (Fils)
         ReDim Preserve TSpl(UBound(TSpl) - 1)
         TRés(LR, 1) = Join(TSpl, " - ") ' ................... Join les Cases du Tableau "TSpl" de la (Désignation "Pére" --->>> Racine de cette ARBORECENSE : Exemple 1.5.6.3 Soit "1-5-6" en Ligne LR de la Colonne 1 du Tableau "TRés"
       ' Si il y a un manque
         If Err Then
         TRés(LR, 1) = " *****    * MANQUE LE NUMERO D'ARBORECENSE POUR LA : Désignation (Pére) *     ******* " 'Désignation (Pére)
         TRés(LR, 2) = " *****    * MANQUE LE NUMERO D'ARBORECENSE POUR LA : Désignation (Fils) *     ******* " 'Désignation (Fils)
         End If
         On Error GoTo 0
       ' Suite du Programme

B) Doublon sur les Numérotation d'Arborescence :
Cela crée des incohérence dans la restitution des données

Exemple : Doublon !
° Ligne A17 N° Arborcense "2.1.1" ----->>> (Prix 2.1.1Doublon 2.1.1 = Erreur !)
° Ligne A20 N° Arborcense "2.1.1" ----->>> (Sous Sous Chapitre 2.1.1)

La Ligne N°7 du fichier devrait être : Prix 2.1.1Doublon 2.1.1 = Erreur !

J'ai cru comprendre que l'érreur générer est du à cette ligne qui remplis toujours la
variable privé du module de classe (Private LeTexte As String)
avec cela dans le Module Standard (SsRub.Txt = TDon(LD, 2))
Car dans le Module de classe : avec cette fonction
* Public Function Item(ByVal Rub As String) As Rubrique
La Gestion de l'erreur [On Error Resume Next]
Doit être lié à cette erreur.

Question Supplémentaire (En Vrac)
a) Y a t'il une possibilité de vérifier la cohérence de l'arborescence ?
b) La Variable Parent peut être utile pour une interactions avec se code ?
c) Avec la possibilité de retrouver l'arborescence il y a des Options ?

* Voila @Dranred J'ai vraiment travaillé sur votre programme et essayé de comprendre au mieux et tous commenté en Partie 1 et Partie 2 Expliquer ce que j'ai pu... Puis les questions et aussi les Erreurs que j'ai trouvé en testant.
* J'ai rien Modifier de votre code Original sauf les détails pour la restitution sur la Feuil "Résultat obtenu"

Ps : Lorsqu'il y a les Erreurs je suis passé en mode débogage en Pas à Pas est j'ai passer les
instruction bloquantes, pour avoir le résultat dans la feuil "Résultat obtenu"
Je Poste le Fichier Excel : RestitutionArborecenseEnBaseDeDonnéesDranred_V0.xlsm

Dranreb · 3 Août 2021

1 — La méthode Init du Person la prend, Mais vous avez oublié de l'utiliser dans la méthode Item du Persons commentée, conformément à ce que j'avais indiqué au#26
2 — Dans quel code ? Ce serait une nouvelle procédure récursive qui redécortiquerait en aveugle la RubGlobale. Mais pas sûr que vous en aurez besoin en fin de compte.

Bon, heu … qu'est ce qui n'allait pas dans la procédure d'origine par rapport à ce que vous auriez voulu ?
Si je comprends bien vous voulez la chaine des rubriques en colonne 1, et repousser tout le reste d'une colonne vers la droite, mais pour la désigneation vous voulez toujours la chaine des désignations séarées par des " — " ou bien seulement la désignation terminale ?
Ah non, vous voulez la désignaion terminale dans une colonne à part …
Mais il ne faut pas de doublon dans les données bien sûr. Sinon il prend la dernière désignation trouvée.
Vous ne voulez quand même pas j'espère, qu'il puisse y avoir conjointement deux sortes de chaines de chapitres pouvant coexister, une sans U, Qté etc. et l'autre avec ???

laurent950 · 3 Août 2021

Re @Dranred

Dranreb à dit:
1 — La méthode Init du Person la prend, Mais vous avez oublié de l'utiliser dans la méthode Item du Persons commentée, conformément à ce que j'avais indiqué au#26

J'ai pas su l'utilisé mais j'ai bien lu le Poste #26
Comment l'utilisé ?
On peut le laissé de côté pour l'instant et y revenir ensuite.

Dranreb à dit:
2 — Dans quel code ? Ce serait une nouvelle procédure récursive qui redécortiquerait en aveugle la RubGlobale. Mais pas sûr que vous en aurez besoin en fin de compte.

Pour ce Poste 2 :
J'aimerais bien connaitre le principe et savoir le coder aussi.
On peut le laissé de côté pour l'instant et y revenir ensuite.

Pour cela le Code actuel :
Très Important pour :
1) Les Numéro d'arborescence génères des erreurs dans la restitution des données.
Je ne sais pas gérer cela @Dranred

Ici j'ai su gérer (est-ce que mon code est correcte dans le module Standard)
2 ) Si pas de Numéro d'arborescence
J'ai su faire et j'ai ajouter le code qui fait le repérage de cette erreur (Pour revenir ensuite corriger)

Je joins le fichier Version V1 (En rapport avec explication en Poste #28
Fichier excel : RestitutionArborecenseEnBaseDeDonnéesDranred_V1.xlsm

Réponse :
Exemple Pour 1.2.4.5.6
Dranred :
Si je comprends bien vous voulez la chaine des rubriques en colonne 1
Oui Soit 1.2.4.5.

Dranred :
et repousser tout le reste d'une colonne vers la droite
Juste 6

Moi
repousser tout le reste ~~d'une colonne~~ sur plusieurs colonnes
Soit U / Quantité / PU / Mt (Soit 4 Colonnes)

Merci @Dranreb

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

laurent950

XLDnaute Barbatruc

Pièces jointes

Dranreb

laurent950

XLDnaute Barbatruc

Pièces jointes

laurent950

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Pièces jointes

laurent950

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Pièces jointes

Discussions similaires