Fonction requête récursive VBA
Bonjour à tous,
Je me tourne vers vous, car je rencontre quelques difficultés dans la prog en VBA. Voici mon probleme:
Je dispose d'une table de lien pere fils qui se presente de la forme suivante:
pere Fils
toto tata
toto titi
toto tete
tata sasa
tata soso
titi jojo
soso fufu
et je souhaiterais arriver au résultat suivant:
niv0 niv1 niv2 niv3
toto tata sasa
toto tata soso
toto tata soso fufu
toto titi jojo
toto tete
J'ai dans un premier temps réussi à arriver au résultat final via assistant de création de requetes d'acces mais j 'aurai besoin transcrire l 'ensemble de ces requetes en VBA dans une fonction récursive.
Merci pour l'aide que vous pourrez m'apportez
Quelques infos supplémentaires
Bonjour,
Je résume : pour chaque dernier de lignée, tu veux la liste de ses ascendants.
1re étape
Pour reconnaître qu’il s’agit d’un dernier de lignée, on va vérifier qu’il n’a pas de fils.
Voici une fonction qui donne le nom d’un fils (le premier au hasard) pour un individu donné en paramètre :
Code:
1 2 3
| Public Function Fils(Ascendant As String) As String
Fils = Nz(DLookup("Fils", "Filiations", "pere=""" & Ascendant & """"), "")
End Function |
Cette fonction renvoie « vide » si l’individu n’a pas de fils. Dans ce cas, l’individu est donc un dernier de lignée.
2e étape
Pour construire la filiation, il faut connaître le père de chacun.
Voici la fonction
Code:
1 2 3
| Public Function Pere(Descendant As String) As String
Pere = Nz(DLookup("pere", "Filiations", "fils=""" & Descendant & """"), "")
End Function |
3e étape
Pour chaque dernier de lignée, on va utiliser la fonction pere en boucle. On cherche d’abord le père du dernier de lignée, ensuite le grand-père… jusqu’à ce que la fonction renvoie « vide ». C’est alors le patriarche. Fin de la boucle.
Voici une fonction qui fait le travail. Au fur et à mesure, les noms des membres sont notés de la droite vers la gauche et séparés par le signe « | » (Alt +124).
Ce signe « rare » est choisi comme séparateur parce qu’on est sûr qu’aucun nom ne le contient.
Voici la fonction
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
| Public Function Lignee(Individu As String) As String
Dim Ascendant As String, Descendant As String, Tous() As String
Lignee = Individu
Descendant = Individu
Do
Ascendant = Pere(Descendant)
If Ascendant <> "" Then
Lignee = Ascendant & "|" & Lignee
Descendant = Ascendant
Else
Exit Do
End If
Loop
' on retient si le premier n'a pas de père et si le dernier n'a pas de fils
Tous = Split(Lignee, "|")
If Pere(Tous(0)) <> "" Or Fils(Tous(UBound(Tous))) <> "" Then Lignee = "": Exit Function
'If Fils(Tous(UBound(Tous))) <> "" Then Lignee = "": Exit Function
End Function |
4e étape
Pour présenter le résultat comme tu le souhaites, il « suffit » de décomposer une lignée et de loger chaque membre dans le champ de la table qui correspond à son niveau.
Voici la routine qui fait le travail. Elle est associée au clic sur le bouton.
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
| Public Sub CreerLaTable()
Dim rst As Recordset, Individu() As String, sSql As String
DoCmd.SetWarnings False
'purger la table Resultat
DoCmd.RunSQL ("DELETE Resultat.niv0 FROM Resultat;")
'Lire le contenu de la table filiations du début à la fin
Set rst = CurrentDb.OpenRecordset("filiations")
Do Until rst.EOF
If Lignee(rst("fils")) <> "" Then 'si c'est une lignée on continue, si non au suivant
' on crée un tableau avec chaque valeur
Individu = Split(Lignee(rst("fils")), "|")
' on construit le sql d'une requête ajout (modulée selon le nombre d'éléments)
sSql = "INSERT INTO Resultat ( niv0, niv1"
If UBound(Individu) >= 2 Then sSql = sSql & ", niv2"
If UBound(Individu) >= 3 Then sSql = sSql & ", niv3"
sSql = sSql & " ) " _
& "SELECT """ & Individu(0) & """ AS Expr0, """ _
& Individu(1) & """ AS Expr1"
If UBound(Individu) >= 2 Then sSql = sSql & ", """ & Individu(2) & """ AS Expr2"
If UBound(Individu) >= 3 Then sSql = sSql & ", """ & Individu(3) & """ AS Expr3"
sSql = sSql & ";"
' on exécute la requête ajout pour cette lignée
DoCmd.RunSQL (sSql)
End If
' on lit le suivant
rst.MoveNext
Loop
DoCmd.SetWarnings True
' un message de bonne arrivée
MsgBox "la table est créée, tu peux vérifier" & vbLf & " A la prochaine."
End Sub |
Pour t’aider à comprendre la syntaxe : dans le code, tu places ton curseur à l’intérieur d’un mot et tu enfonces F1 ---> l’aide Access s’affiche à la bonne page. Si cela ne suffit pas, reviens.
Au plaisir de te recroiser.