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]

Bonsoir.
Code déjà proposé aussi en conversation :

Option Explicit
Sub ConcatDésign()
   Dim TDon(), LD&, TRés(), LR&, DébutDsg As String, C&
   TDon = PlgUti(Feuil1.[B2]).Value
   ReDim TRés(1 To UBound(TDon, 1), 1 To 5)
   For LD = 1 To UBound(TDon, 1)
      If IsEmpty(TDon(LD, 3)) Then
         DébutDsg = TDon(LD, 1) & ", "
      Else
         LR = LR + 1
         TRés(LR, 1) = DébutDsg & TDon(LR, 1)
         For C = 2 To UBound(TDon, 2): TRés(LR, C) = TDon(LD, C): Next C
         End If: Next LD
   Feuil4.[G2:K10000].ClearContents
   Feuil4.[G2:K2].Resize(LR).Value = TRés
   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é.
   Dim LMax As Long, CMax As Long, NbL As Long, NbC As Long
   On Error GoTo RienTrouvé
   If PlagExam Is Nothing Then Set PlagExam = PlageDép.Worksheet.UsedRange
   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)
   Exit Function
RienTrouvé: Resume CEstToutVide
CEstToutVide: Set PlgUti = Nothing
   End Function

 

[Dranreb]

Remarque: je m'aperçois que les désignations obtenues ne sont pas exactement celle attendues dans cette feuille finale, contrairement à ce qu'il m'avait semblé voir dans les feuilles intermédiaires

 

[Dranreb]

J'ai une vague idée que je vais essayer, à base de PartDsg(0 To 6, 1 To 100) As String, TSpl() As String

 

[patricktoulon]

Bonsoir Laurent , Dranreb
je n'ai pas regardé ton projet mais voici un exemple simpliste de ce que c'est une fonction récursive
c'est a but école et juste pour te montrer comment on se promène avec les variables dans la récursivité
alors on peut soit utiliser des variables public soit des variable static soit injecter la variable principale

ici dans cet exemple la variable "tablo est static
ca veux dire que comme une variable public elle ne se redim pas a chaque appel de la fonction
sauf qu'elle est a l’intérieur de la fonction et non en globale module
alors c'est pas du grand art mais je pense que ça va t'aider a comprendre la récursivité

Sub test()
    montablo = hop_on_mouline(1, 100, True)
    Cells(1, 1).Resize(UBound(montablo), 2) = montablo
End Sub

Function hop_on_mouline(minus, maxi, Optional cleartablo As Boolean = False)
    Static tablo(1  To maxi, 1 To 2)
    If cleartablo Then Erase tablo: tablo(1, 1) = 0
    If minus <= maxi Then
        If minus Mod 10 = 0 Then tablo(minus, 1) = minus Else tablo(minus, 2) = minus
        hop_on_mouline minus + 1, maxi ' on r'appelle la fonction (récursivité ) en réinjectant minus+1 et maxi
    Else:
    End If
 hop_on_mouline = tablo ' ben a la fin on a notre tablo de valeur indenté
End Function

on obtiens dans la feuille une arborescence les nombres mod 10 parent des autres
certes c'est simpliste ,j'aurais pu faire ça dans une simple boucle mais c'est juste pour te donner un exemple récursif

comme c'est une variable static et donc elle se redim pas j'ai ajouté un 3eme argument OPTIONAL utilisé seulement lors du premier appel pour la vider les appels récursif ne reçoive pas ce 3 eme argument
voila comme tu peux le voir la boucle(il n'y en a pas) c'est la récursivité qui fait le tourniquet

 

[Dranreb]

Il y a du mieux avec ce code :

Sub ConcatDésign()
   Dim TDon(), LD&, TRés(), LR&, PartDsg(0 To 6, 0 To 300) As String, _
      TSpl() As String, P As Integer, C&
   TDon = PlgUti(Feuil1.[A2]).Value
   ReDim TRés(1 To UBound(TDon, 1), 1 To 5)
   For LD = 1 To UBound(TDon, 1)
      TSpl = Split(TDon(LD, 1), ".")
      P = UBound(TSpl): PartDsg(P, TSpl(P)) = TDon(LD, 2)
      If Not IsEmpty(TDon(LD, 4)) Then
         For P = 0 To UBound(TSpl)
            TSpl(P) = PartDsg(P, TSpl(P))
            Next P
         LR = LR + 1
         TRés(LR, 1) = Join(TSpl, " - ")
         For C = 2 To 5: TRés(LR, C) = TDon(LD, C + 1): Next C
         End If: Next LD
   Feuil4.[G2:K10000].ClearContents
   Feuil4.[G2:K2].Resize(LR, 5).Value = TRés
   End Sub

Bonne nuit.

 

[patricktoulon]

dans cet exempla la variable(variant) est dans la sub et transporté vers la fonction qui ne retourne plus rien mais sert simplement a aménager le le tableau"tabl" et toujours en récursif

Sub test2()
    Dim tabl(1 To 100, 1 To 2)
    hop_on_mouline2 1, 100, tabl
    Cells(1, 1).Resize(UBound(tabl), 2) = tabl
End Sub

Function hop_on_mouline2(minus, maxi, tabl())
     If minus <= maxi Then
        If minus Mod 10 = 0 Then tabl(minus, 1) = minus Else tabl(minus, 2) = minus
        hop_on_mouline2 minus + 1, maxi, tabl ' on r'appelle la fonction (récursivité ) en réinjectant minus+1 et maxi
    Else:
    End If
 hop_on_mouline2 = tabl ' ben a la fin on a notre tablo de valeur indenté
End Function

 

[kiki29]

Salut, à lire : Récursivité ainsi que Cours sur la récursivité

 

[Dranreb]

Bonjour.
Toujours pas de procédure récursive nécessaire dans cette version pour constituer la hiérarchie ni la consulter en accès direct, mais exécution en 2 passes au cas où, tout étant en ordre quelconque, on aurait besoin d'un morceau spécifié seulement ultérieurement en tant que texte terminal.

 

[laurent950]

Bonsoir @Dranreb , @patricktoulon , @kiki29

Je poste une nouvelle base de travail que je viens de constituer sur le fichier Excel ci-joint.

Le Principe est décrit en Poste #1 pour le résultat à Obtenir.

Le nouveau Fichier a un arborescence complète.

Merci @Dranreb pour toute votre aide apporté. Mille Merci

Merci @patricktoulon pour l'exemple et le temps passé c'est vraiment très agréable et j'apprend beaucoup

Merci a @kiki29 pour les Cours et les liens

Mais Surtout un immense Merci à @Dranreb qui est très très fort et qui m'aide vraiment énormément sur cette problématique que je n'arrive pas a résoudre. Alors Mille merci @Dranreb

Je Poste le fichier

 

[laurent950]

Re @Dranreb
Avec le nouveau fichier et votre code
il y a un indice qui n'appartient pas a la sélection.
Ca coince avec la variable tableau
Ici juste avant ca passe pas dans le code avec cette ligne
TSpl = Split(TDon(LD, 1), ".")

 

[Dranreb]

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

 

[laurent950]

Merci @Dranreb vous avez trouvez la solution, votre code est magnifique. je vais le décortiquer en pas à pas pour vraiment comprendre.
Je suis plus a l'aise avec les Modules de Classe pour comprendre, j'aime beaucoup votre code et je suis content de ne pas avoir a faire a la récursivité.

Mille Merci @Dranreb je suis très très content de cette solution trouvé.

Ps : Vous êtes vraiment très très fort.

Laurent

 

[laurent950]

Bonsoir le Forum,

Suite à ce Poste :
C'est l'article sur les collections : https://sinarf.developpez.com/access/vbaclass/#L3-1
* 2-5. La propriété Parent
Impossible d'instancier l'objet Parent !
Impossible de rentrer dans la Condition !
avec cette ligne de code
'l'objet est inséré dans la collection on automatiquement renseigne la propriété Parent

Set objPerson.Parent = Me

' ?????????????? Private mobjParent As Person OU Private mobjParent As Person
' IMPOSIBLE D INSTANCIER CET OBJET !
'Propriété Parent
Property Set Parent(ByRef objPersons As Persons)
    If objPersons Is Nothing Then
        mobjParent = objPersons
    End If
End Property

Property Get Parent() As Persons
    Parent = mobjParent
End Property
[QUOTE]

[/QUOTE]

 

[Dranreb]

Il ne faut pratiquement jamais transmettre ByRef un objet. Ça revient à transmettre la variable objet, afin que la procédure puisse la manipuler, c'est à dire l'initialiser par un Set. Or on a rarement ce besoin.
En général la procédure n'a besoin de connaitre que l'adresse d'un exemplaire défini, et pour ça le transmettre ByVal est suffisant, inutile de transmettre l'adresse de l'emplacement contenant l'adresse de l'exemplaire. Surtout si en plus c'est une expression qu'on y passe: comme il n'a pas le droit d'exposer une expression à la modification possible du fait qu'elle est transmise ByRef il est en plus obligé de fabriquer la variable objet temporaire pour pouvoir transmettre son adresse !
J'ai ouvert votre classeur maintenant.
En compilant le projet je tombe sur un mot 'Sélectionnez' qui n'a rien à faire là.
Après l'avoir supprimer je n'ai plus d'erreur et l'exécution va jusqu'au bout.
Mais je trouve ça mal foutu: une méthode Add doit à mon avis se débrouiller pour fabriquer toute seule un objet de sa collection. C'est là qu'entre en jeu une Méthode Init du membre où la classe collection transmet Me.