Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 fonction récursive remonter à la source du manquant nomenclature

ApprentieDranreb

XLDnaute Nouveau
Bonjour,
je suis nouveau dans le forum et je compte sur votre compréhension et votre aimabilité.
çela fait un petit moment que j'essaie de mettre en place une fonction récursive à intégrer à plusieurs niveau
c'est à dire mes champs sont dans les cellules
i = 14
G & i et L & i
variable1
tant que G & i <> L & i
variable1 = L & i
je viens chercher cette variable dans la colonne G & i
si je la trouve 1 résultat
' je créer un entête niveau 1.0
je copie ça correspondance de la colonne L & i dans une nouvelle cellule AD & i
' je créer un entête niveau 1.1
si je la trouve 2 résultats
je copie ça correspondance de la colonne L & i dans une nouvelle cellule AE & i
...........

sachant que le resultat lui meme peut avoir avec un père également et si c'est le cas

' je créer un entête niveau 2.0
je copie ça correspondance de la colonne L & i dans une nouvelle cellule A... & i cela dépend de combien de résultat j'ai trouver j'ai trouver.


MODELE TABLEAU DE BORD
Colonne GColonne LNiveau 1.01.11.22.03.03.1
AXXYZKLM
AY
AZK
ZKLM
KL
KM

j'espère être assez claire sinon n'hesitez pas à me demander plus d'explication
 

ApprentieDranreb

XLDnaute Nouveau
Dranreb, je tiens tout d'abord à vous exprimer ma gratitude pour ce que vous avez accompli jusqu'à présent.

En ce qui concerne le reste, je vais essayer de trouver une méthode pour jongler entre les deux informations. Je vais créer la descendance avec un espacement entre chaque niveau, puis faire une rechercheV pour récupérer les données associées à chaque Gen.

Effectivement, cette approche pourrait nécessiter davantage de ressources et de temps d'exécution, mais au moins elle garantira l'obtention du résultat souhaité en attendant de trouver la formule optimale.

Bonne fin de journée et bon week
 

Dranreb

XLDnaute Barbatruc
Vous ne le trouvez pas bien mon objet Chose muni d'une Collection où il est si facile de naviguer ?
Remarque: cette collection contient actuellement les objets de type Chose qui sont ses fils.
Mais s'il y avait des informations propres à chaque lien, il vaudrait peut être mieux créer un nouveau type d'objet pour les y ranger, et mettre ces objets là dans la collection.
 
Dernière édition:

ApprentieDranreb

XLDnaute Nouveau
Bonjour Dranreb, j'espère que vous avez passé un bon week end.
pour ma part j'ai passé pas mal de temps sur VBA sans succès, je n'ai pas eu la chance d'avoir le résultat souhaité quand je trouve l'Aïeul ou le Gen, je suis incapable de faire véhiculer les 18 champs le concarnant avant de ramener Gen-1 ou Gen-2.
en gros je suis dans l'impasse et aide à se sujet serai formidable.
 

Dranreb

XLDnaute Barbatruc
Bonjour. Je vous l'ai dit, ajoutez une propriété Ligne dans l'objet Chose. Avec le numéro de ligne vous pourrez transférer toutes les colonnes que vous voudrez de cette ligne. Si ce sont des colonnes propre au seul lien avec un fils particulier, créez plutôt un objet Lien portant ce numéro de ligne.
En somme vous m'aviez parlé pour rien d'un état où vous n'aviez besoin que d'une désignation du père en plus mais je l'avais fait :
 

Pièces jointes

  • thedarkness.elhitmy2.xlsm
    44 KB · Affichages: 2
Dernière édition:

ApprentieDranreb

XLDnaute Nouveau
Bonjour Dranreb, j'ai essayé d'appliquer des ajouts de champs dans le fichier :
- admettons que le je veux ajouter un champ InfoP et InfoF
1- j'ajoute les bvariable dans le module Noterlien à savoir
For L = 1 To UBound(TDon)
' ajoute des deux champs InfoP et InfoF
NoterLien TDon(L, CA), TDon(L, CA + 1), TDon(L, CA + 2), TDon(L, 5 - CA), TDon(L, 6 - CA), TDon(L, 7 - CA), Descend, Cln
Next L

2- dans la classe je les déclare
-InfoP
Property Let InfoP(ByVal RHS As String)
If Not IsEmpty(RHS) Then SonInfo = RHS
End Property

Property Get InfoP() As String
InfoP = SonInfo
End Property


- Infos
Property Let InfoP(ByVal RHS As String)
If Not IsEmpty(RHS) Then SonInfo = RHS
End Property

Property Get InfoP() As String
InfoP = SonInfo
End Property


je récupère bien mes champs sauf au moment de poser tout que je me perd :

Private Sub PoserTout(TRés(), L As Long, ByVal C As Integer, ByVal Chose As Chose)
If C + 2 > UBound(TRés, 2) Then ReDim Preserve TRés(1 To UBound(TRés, 1), 1 To C + 2)

TRés(L + 1, C) = Chose.Nom
TRés(L + 1, C + 1) = Chose.Dsgn
TRés(L + 1, C + 2) = Chose.Info

If Chose.Fils.Count = 0 Then
L = L + 1
Else
Dim FilsChose As Chose
For Each FilsChose In Chose.Fils
PoserTout TRés, L, C + 2, FilsChose
Next FilsChose
End If

Do While C > 2
C = C - 2
If IsEmpty(TRés(L, C)) Then
TRés(L, C) = TRés(L - 1, C)
TRés(L, C + 1) = TRés(L - 1, C + 1)
End If
Loop
End Sub

Property Let TableauRetaillé(ByVal LOt As ListObject, Optional ByVal LMax As Long, TVals())
Dim Trop As Long, CMax As Long, TFml(), F As Long
If LMax = 0 Then LMax = UBound(TVals, 1)
Trop = LOt.ListRows.Count - LMax
If Trop > 0 Then
LOt.ListRows(LMax + 1).Range.Resize(Trop).Delete xlShiftUp
ElseIf Trop < 0 And LMax + Trop > 1 Then
LOt.ListRows(LMax + Trop).Range.Resize(-Trop).Insert xlShiftDown, xlFormatFromLeftOrAbove
End If
CMax = UBound(TVals, 2) + 1
Trop = LOt.ListColumns.Count - CMax
If Trop > 0 Then
LOt.ListColumns(CMax + 1).Range.Resize(, Trop).Delete xlShiftToLeft
ElseIf Trop < 0 And CMax + Trop > 1 Then
LOt.ListColumns(CMax + Trop).Range.Resize(, -Trop).Insert xlShiftToRight, xlFormatFromLeftOrAbove
End If
If LMax = 0 Then Exit Property
ReDim TFml(1 To LOt.ListColumns.Count)
For F = 1 To UBound(TFml)
With LOt.HeaderRowRange(2, F)
If .HasFormula Then TFml(F) = .Formula2R1C1 Else TFml(F) = Null
End With: Next F
LOt.HeaderRowRange.Offset(1).Resize(LMax).Value = TVals
For F = 1 To UBound(TFml)
If Not IsNull(TFml(F)) Then LOt.ListColumns(F).DataBodyRange.Formula2R1C1 = TFml(F)
Next F
End Property


en complément j'ai ajouté cette condition
For C = 3 To LOtR.ListColumns.Count Step 2
' Ajouter une vérification pour éviter les erreurs si le nombre de colonnes est impair
If C + 2 <= LOtR.ListColumns.Count Then
LOtR.ListColumns(C).Name = "Gén." & IIf(Descend, "+", "-") & C \ 3
LOtR.ListColumns(C + 1).Name = "Dsg. G" & IIf(Descend, "+", "-") & C \ 3
LOtR.ListColumns(C + 2).Name = "Info" & IIf(Descend, "+", "-") & C \ 3
End If
Next C


la finalité, c'est d'acquérir l'automatisme d'ajouter n champs par niveau sans pour autant tout casser.


Par avance merci pour le temps que m'avez fourni.
Cdlt
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Je proposai de simplement noter le numéro de ligne dans le lien
Module MNoterLien :
VB:
Public Sub NoterLien(ByVal NomPère As String, ByVal Ligne As Long, _
   ByVal NomFils As String, ByVal LLien, ByVal Cln As Collection)
Rem. Ajoute à un objet Chose père un lien vers un autre objet Chose fils.
'  Arguments :
'     NomPère: Nom de l'objet Chose père.
'     Ligne:   Numéro de ligne où le père est décrit dans une base générale.
'     NomFils: Nom de l'objet Chose fils.
'     LLien:   Numéro de ligne dans un tableau Excel de liaisons contenant des informations propres au lien.
'     Cln:     Collection où les deux objets Chose peuvent déjà se trouver. Sinon ils y sont ajoutés.
'  Remarque
'     Ligne est proposé à tout hasard, mais vous pouvez le spécifier à 0. En principe il devrait déjà avoir été donné.
   Dim Père As Chose, Lien As New Lien, Fils As Chose
   Set Père = Chose(NomPère, Ligne, Cln)
   Set Fils = Chose(NomFils, 0, Cln)
   If PèreDansFils(Père, Fils) Then
      MsgBox """" & Père.Nom & """ descend déjà de """ & Fils.Nom & """." _
         & vbLf & "Lien inverse rejeté.", vbExclamation, "NoterLien"
      Exit Sub: End If
   Fils.EstFils
   Père.AddLienFils Fils, LLien
   End Sub
Classe Lien :
VB:
Option Explicit
Private SaChose As Chose, SaLigne As Long
Public Sub Init(ByVal Fils As Chose, ByVal Ligne As Long)
   Set SaChose = Fils
   SaLigne = Ligne
   End Sub
Public Function Fils() As Chose
   Set Fils = SaChose
   End Function
Public Function Ligne() As Long
   Ligne = SaLigne
   End Function
N'auriez vous un exemple de vos données avec les vrais intitulés de colonnes ?
Voulez vous sortir à la suite tous les dépendants, directs et indirects de chaque chose sans antécédent ?
 

ApprentieDranreb

XLDnaute Nouveau
ci-joint fichier model ; tous est disponible dans l'onglet Data
- le restltat s'affichera dans l'onglet Resltat
- la coche descendence doit être toujours à "True" ( On peut l'intégrer directement dans le code sans la rendre visible)
- chaque ancêtre dispose de 19 champs
-chaque descendance dispose de 19 champs
- c'a veut dire que si un ancêtre dispose de 5 descendance, cela nous fais 19*5 = 95 colonnes
j'espère que cela est claire sinon n'hésitez pas à revenir vers moi plus de détail.

Un grand merci d'avance Dranreb
 

Pièces jointes

  • Fichier_Model.xlsx
    17.1 KB · Affichages: 2

ApprentieDranreb

XLDnaute Nouveau
C'est pas possible de simplement produire une ligne par descendant, direct ou indirect, vu que les données de l'ancêtre sont répétées sur chaque ligne ?

Si chaque ligne est enregistrée une seule fois pour chaque descendant, cela pourrait entraîner des erreurs lors de la recherche de descendants ultérieurs, car les filtres basés sur un descendant particulier peuvent ne pas être corrects. L'objectif est de pouvoir effectuer des analyses multiples à plusieurs niveaux et sur plusieurs champs.

Ancetre libellee ..... Champ18 Gen+1 libellee ..... Champ18 Gen+2 libellee ..... Champ18
A LibelleA .... Champ 19 B libellee ..... Champ18 D libellee ..... Champ18
A LibelleA .... Champ 19 B libellee ..... Champ18 E libellee ..... Champ18
A LibelleA .... Champ 19 C libellee ..... Champ18
 

Dranreb

XLDnaute Barbatruc
Oui mais elles sont enregistrées plusieurs fois si elles descendent de plusieurs ancêtres différents, et alors à des colonnes différentes ?
Il vaudrait peut être mieux que les analyse multiples dont vous parlez soient aussi faites en explorant la collection.
19 et 19, ce sont les même éléments, si oui, plutôt que de les répéter ne vaudrait il pas décrire tous les articles dans une base article et seulement les liens dans une autre base ?
 

ApprentieDranreb

XLDnaute Nouveau
pour l'enregistrement des info en mémoire on peut le faire qu'une fois, mais au moment de tous poser dans l'onglet résultat il faut les poser 1 à n fois a chaque qu'on fait appel à cette article dans n'importe quel niveau il faut ramener ces information avec.
Ancetre libellee ..... Champ18 Gen+1 libellee ..... Champ18Gen+2 libellee ..... Champ18Gen+2 libellee ..... Cham18
A LibelleA .... Champ 19 B libellee ..... Champ18 D libellee ..... Champ18 Q libellee .. Cham18
A LibelleA .... Champ 19 B libellee ..... Champ18 D libellee ..... Champ18 L libellee .. Cham18
A LibelleA .... Champ 19 B libellee ..... Champ18 E libellée ..... Champ18
A LibelleA .... Champ 19 C libellee ..... Champ18
X LibelleA .... Champ 19 D libellee ..... Champ18 Q libellee ..... Champ18
Y LibelleA .... Champ 19 D libellee ..... Champ18 L libellee ..... Champ18
Z LibelleA .... Champ 19 E libellee ..... Champ18
 

Dranreb

XLDnaute Barbatruc
Voilà déjà ce que ça pourrait donner en mettant tous les descendant l'un en dessous de l'autre.
Pour diminuer un tout petit peu l'objection vaguement exposée au #29, j'ai ajouté une colonne supplémentaire "Père" qui restitue le parent direct de la chose, pour les cas où ce n'est pas l'ancêtre. Pour ce dernier, je ne retiens comme étant à reproduire que les informations de la première ligne où il apparaît.
 

Pièces jointes

  • thedarkness.elhitmy4.xlsm
    48.5 KB · Affichages: 1

ApprentieDranreb

XLDnaute Nouveau
Bonjour Dranreb, je pense qu'il y une erreur sur le fichier,
le fichier précèdent ne fait pas la descendance correcte

- le fichier model (1) dispose des données réelles qui reflète la situation actuelle

- l'affichage du résultat attendu et dans le fichier visualisation :
- On a deux onglet Data et résultat
je le rejoint à cette discussion et je te remercie pour le temps consacré
 

Pièces jointes

  • Fichier_Model (1).xlsx
    24.2 KB · Affichages: 1
  • Fichier_Model_Visualisation.xlsm
    53.4 KB · Affichages: 1

Discussions similaires

Réponses
8
Affichages
867
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…