Fonction récursive en VBA

**GuiBar18** · 28/06/2012, 16h01

Bonjour à tous,

Je vous expose mon problème : je possède une table organisée comme suit :

Colonne A : Nom
Colonne B : élément parent
Colonne C : Valeur

Chaque éléments de la colonne A a un et un seul élément parent, sauf le "dernier" parent qui n'a personne de renseigné
En fait je veux faire des calculs en remontant un arbre.

Dans le détail "pratique" la situation est la suivante : j'ai plusieurs ouvrages dont chacun concerne X habitants. Les ouvrages sont les uns derrière les autres. Ainsi l'ouvrage 1 reçoit les habitants des ouvrages 2 et 3 en plus des siens propres. L'ouvrage 2 reçoit les hab des ouvrages 4 et 5 en plus des siens ... ...
Le nombre total d'habitants reçu par l'ouvrage 1 est donc :

Les habitants en propre sur l'ouvrage 1
Les habitants sur l'ouvrage 2 qui sont eux même
- Les habitants de l'ouvrage 2 en propre
- Les habitans sur l'ouvrage 4
- Les habitants sur l'ouvrage 5

Et ainsi de suite. J'espère être clair dans le description du problème (du point de vue informatique et pratique), sinon n’hésitez pas

Le but du schmilblik est de faire la somme en remontant l'arbre ainsi créé et d'avoir le nombre d'habitants total sur chaque ouvrage

Pour être plus clair, je vous ait mis un exemple en fichier (ici 6 éléments). Si l'on fait la somme des valeurs pour le parent DO1 de l'exemple, on doit obtenir 6, 1 pour le DO2 (qui n'a pas d'enfant et à juste sa valeur propre), 4 pour le DO3, 3 pour le DO4, 1 pour le DO5 le DO6 (qui n'ont eux non plus pas d'enfant, juste une valeur propre).
Ainsi, on remarque que la valeur de DO1 est fonction de la valeur de DO3 qui est fonction de la valeur de DO4 qui est fonction de celle de DO5 et de DO6 ...

En informatique cela correspond bien à une fonction récursive qui va s'appeler elle même.
Pour effectuer mon calcul, j'ai mis en place le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Sub Calcul_Aval()
 
Dim Donnees As Worksheet 'Feuille de travail
 
Dim Nbreval As Integer 'Mesure de la liste d'éléments élémentaires
Dim i As Integer 'Compteur de boucle
Dim p As Integer 'Compteur de ligne dans le tableau ListeInitial
Dim p1 As Integer 'Compteur de ligne secondaire dans le tableau ListeInitial
Dim q As Integer 'Compteur de colonne dans le tableau (0=père,1=fils, 2=valeur propre, 3=Résultat)
 
Dim Somme_Aval As Double
 
Dim ListeInitiale() As String 'Tableau contenant la liste intiale avec les valeurs propres
 
Set Donnees = Worksheets("DONNEES")
 
Nbreval = Donnees.Range("A1").End(xlDown).Row - 1
 
ReDim ListeInitiale(Nbreval, 3) 'Création d'un tableau comprenant le nombre d'éléments élémentaires
'Initialisation des compteurs du tableau initial
p = 0
 
'Initialisation de la ligne de début de calcul
i = 2
 
'Remplissage de l'array intial (recopie du tableau initial)
For p = 0 To Nbreval - 1
    For q = 0 To 2
        ListeInitiale(p, q) = Cells(i, q + 1)
    Next q
 
    q = 0
    i = i + 1
Next p
 
'Début du calcul recursif : pour chaque ligne dans le tableau, ie pour chaque BV élémentaire
For p = 0 To (Nbreval - 1)
    Variable = ListeInitiale(p, 0)
    Somme_Aval = ListeInitiale(p, 2) 'la somme vaut toujours au moins la valeur propre
 
    'Ensuite la somme aval vaut le somme de tous les éléments fils.
    p1 = 0 ' on va itérer sur les valeurs des lignes en colonne 2 pour détecter les éléments fils
    For p1 = 0 To Nbreval
        If ListeInitiale(p1, 1) = Variable Then
            'Si on détecte un élément fils, on rapelle la fonction sur cet élément fils
            Fils = ListeInitiale(p1, 0)
            Somme_Aval = Somme_Aval + Element_aval(Fils, ListeInitiale, Nbreval, p1) 'La somme le résultat de la fonction + la somme déjà calculée
        Else
            'Si pas d'élement amont on sort de la boucle si (nous sommes au niveau le plus bas)
        End If
    'On passe alors au prochain BV
    Next p1
    'On passe au calcul aval du prochain BV (prochaine variable)
 
    'Le calcul est fait, on inscrit la valeur calculée dans l'array
    ListeInitiale(p, 3) = Somme_Aval
Next p
 
'Le calcul de toutes les valeurs est fait, on écrit le résultat à l'aide d'une itération
p = 0
i = 2
For p = 0 To Nbreval
    Donnees.Cells(i, 4) = ListeInitiale(p, 3)
    i = i + 1
Next p
 
 
End Sub
 
Function Element_aval(Père, ListeValeur, Taille, PosVP)
'Code de définition de la procédure récursive
 
Dim r As Integer
'Définition de la fonction récursive
 
 
For r = 0 To (Taille - 1)
    If ListeValeur(r, 1) = Père Then
        Fils = ListeValeur(r, 0)
        Element_aval = ListeValeur(r, 2) + Element_aval(Fils, ListeValeur, Taille, r)
    Else: 'Dans les autres cas on ne fait rien
    End If
Next r
 
End Function

Le code tourne mais il me retourne des valeurs erronées et je ne suis pas sur de bien maitriser ce que je fais. Par exemple, il retourne 112 pour DO1, 1 pour DO2, 12 pour DO3, 2 pour DO4 et 1 pour DO5/6.
Si quelqu'un pouvait me donner un petit coup de pouce ça serait pas mal (d'autant que je ne suis pas sur d'avoir tout fait correctement - je fais tout en autodidacte, grâce à ce forum en majeure partie - et que je ne demande qu'à apprendre).

Merci d'avance

**GuiBar18** · 28/06/2012, 17h55

Alors alors, juste pour dire que le Schmilblik avance petit à petit.
Mon premier problème est résolu : j'avais déclaré un array de type string dans lequel je copiais des nombre pour ensuite les additionner. VBA ne me comprenait pas cela comme des nombre (logique) d'où les 112 et compagnie).
J'ai maintenant déclaré un array de type Variant et les choses se passent mieux, beaucoup mieux.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Dim Nbreval As Integer 'Mesure de la liste d'éléments élémentaires
Dim i As Integer 'Compteur de boucle
Dim p As Integer 'Compteur de ligne dans le tableau ListeInitial
Dim p1 As Integer 'Compteur de ligne secondaire dans le tableau ListeInitial
Dim q As Integer 'Compteur de colonne dans le tableau (0=père,1=fils, 2=valeur propre, 3=Résultat)

Dim Somme_Aval As Double

Dim ListeInitiale() As Variant 'Tableau contenant la liste intiale avec les valeurs propres

Toutefois, je n'obtiens toujours pas la bonne somme en fin de calcul, j'ai l'impression que seul une partie de l'arbre est prise en compte.

Voici le code rectifié que j'utilise :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
 
Dim Donnees As Worksheet 'Feuille de travail
 
Dim Nbreval As Integer 'Mesure de la liste d'éléments élémentaires
Dim i As Integer 'Compteur de boucle
Dim p As Integer 'Compteur de ligne dans le tableau ListeInitial
Dim p1 As Integer 'Compteur de ligne secondaire dans le tableau ListeInitial
Dim q As Integer 'Compteur de colonne dans le tableau (0=père,1=fils, 2=valeur propre, 3=Résultat)
 
Dim Somme_Aval As Double
 
Dim ListeInitiale() As Variant 'Tableau contenant la liste intiale avec les valeurs propres
 
Set Donnees = Worksheets("DONNEES")
 
Nbreval = Donnees.Range("A1").End(xlDown).Row - 1
 
ReDim ListeInitiale(Nbreval, 3) 'Création d'un tableau comprenant le nombre d'éléments élémentaires
'Initialisation des compteurs du tableau initial
p = 0
 
'Initialisation de la ligne de début de calcul
i = 2
 
'Remplissage de l'array intial (recopie du tableau initial)
For p = 0 To Nbreval - 1
    For q = 0 To 2
        ListeInitiale(p, q) = Cells(i, q + 1)
    Next q
 
    q = 0
    i = i + 1
Next p
 
'Début du calcul recursif : pour chaque ligne dans le tableau, ie pour chaque BV élémentaire
For p = 0 To (Nbreval - 1)
    Variable = ListeInitiale(p, 0)
    Somme_Aval = ListeInitiale(p, 2) 'la somme vaut toujours au moins la valeur propre
 
    'Ensuite la somme aval vaut le somme de tous les éléments fils.
    p1 = 0 ' on va itérer sur les valeurs des lignes en colonne 2 pour détecter les éléments fils
    For p1 = 0 To Nbreval
        If ListeInitiale(p1, 1) = Variable Then
            'Si on détecte un élément fils, on rapelle la fonction sur cet élément fils
            Fils = ListeInitiale(p1, 0)
            Somme_Aval = Somme_Aval + Element_aval(Fils, ListeInitiale, Nbreval, Pi) 'La somme le résultat de la fonction + la somme déjà calculée
        Else
            'Si pas d'élement amont on sort de la boucle si (nous sommes au niveau le plus bas)
        End If
    'On passe alors au prochain BV
    Next p1
    'On passe au calcul aval du prochain BV (prochaine variable)
 
    'Le calcul est fait, on inscrit la valeur calculée dans l'array
    ListeInitiale(p, 3) = Somme_Aval
 
Next p
 
'Le calcul de toutes les valeurs est fait, on écrit le résultat à l'aide d'une itération
p = 0
i = 2
For p = 0 To Nbreval
    Donnees.Cells(i, 4) = ListeInitiale(p, 3)
    i = i + 1
Next p
 
 
End Sub
 
Function Element_aval(Père, ListeValeur, Taille, Rang)
'Code de définition de la procédure récursive
 
Dim r As Integer
Element_aval = ListeValeur(Rang, 2)
 
'Définition de la fonction récursive
For r = 0 To (Taille - 1)
    If ListeValeur(r, 1) = Père Then
        Fils = ListeValeur(r, 0)
        Element_aval = ListeValeur(r, 2) + Element_aval(Fils, ListeValeur, Taille, r)
    Else: 'Dans les autres cas on ne fait rien
    End If
Next r
 
End Function

Pour info, je suis passé sur un arbre un peu plus compliqué qui balaye l'ensemble des cas possible de liaison. Je remets un fichier exemple avec le nouvel exemple (sans le code) et avec les valeurs que l'on devrait trouver (en colonne F).

**GuiBar18** · 28/06/2012, 18h48

C'est toujours moi ^^.
Comme je l'ai souvent dit, ma phrase préférée est "Aide-toi et le ciel t'aidera". J'ai donc pas mal avancé sur mon code et je sais maintenant où est le problème : il ne parcours qu'une seule branche de l'arbre, mettons à chaque fois la gauche).
Par contre, là je suis vraiment bloqué car je ne comprend absolument pas pourquoi. Dans le doute je vous remets le code auquel j'ai abouti

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
 
Dim Donnees As Worksheet 'Feuille de travail
 
Dim Nbreval As Integer 'Mesure de la liste d'éléments élémentaires
Dim i As Integer 'Compteur de boucle
Dim p As Integer 'Compteur de ligne dans le tableau ListeInitial
Dim p1 As Integer 'Compteur de ligne secondaire dans le tableau ListeInitial
Dim q As Integer 'Compteur de colonne dans le tableau (0=père,1=fils, 2=valeur propre, 3=Résultat)
 
Dim Somme_Amont As Double
 
Dim ListeInitiale() As Variant 'Tableau contenant la liste intiale avec les valeurs propres
 
Set Donnees = Worksheets("DONNEES")
 
Nbreval = Donnees.Range("A1").End(xlDown).Row - 1
 
ReDim ListeInitiale(Nbreval, 3) 'Création d'un tableau comprenant le nombre d'éléments élémentaires
'Initialisation des compteurs du tableau initial
p = 0
 
'Initialisation de la ligne de début de calcul
i = 2
 
'Remplissage de l'array intial (recopie du tableau initial)
For p = 0 To Nbreval - 1
    For q = 0 To 2
        ListeInitiale(p, q) = Cells(i, q + 1)
    Next q
 
    q = 0
    i = i + 1
Next p
 
'Début du calcul recursif : pour chaque ligne dans le tableau, ie pour chaque BV élémentaire on calcule la somme des valeurs propres à l'amont
For p = 0 To (Nbreval - 1)
    'La somme des valeurs à l'amont d'un point est la valeur en propre du point plus les valeurs propres de tous les points à l'aval
    Somme_Amont = ListeInitiale(p, 2) + Element_amont(ListeInitiale(p, 0), ListeInitiale, Nbreval)
    'La fonction Element_amont va chercher à faire la somme de toutes les valeurs à l'amont du Père
 
    'Le calcul est fait, on inscrit la valeur calculée dans l'array
    ListeInitiale(p, 3) = Somme_Amont
Next p
 
'Le calcul de toutes les valeurs est fait, on écrit le résultat à l'aide d'une itération
p = 0
i = 2
For p = 0 To Nbreval
    Donnees.Cells(i, 4) = ListeInitiale(p, 3)
    i = i + 1
Next p
 
 
End Sub
 
Function Element_amont(Père, ListeValeur, Taille)
'Code de définition de la procédure récursive
 
Dim r As Integer
 
 
'Définition de la fonction récursive
For r = 0 To (Taille - 1)
    If ListeValeur(r, 1) = Père Then
        Fils = ListeValeur(r, 0)
        Element_amont = ListeValeur(r, 2) + Element_amont(Fils, ListeValeur, Taille)
    Else: 'Dans les autres cas on ne fait rien
    End If
Next r
 
End Function

**AlphaScorpi** · 28/06/2012, 19h16

j'ai fait rapidement un petit code avec une fonction récursive qui fonctionne

Dans l'exemple, j'ai 3 colonnes.

Colonne 1 : Une liste de lettre (sans doublons)
Colonne 2 : Un montant associé à ces lettres
Colonne 3 : La lettre "parent" de celle colonne 1 (Sauf pour la première ligne qui est vide, et sans boucle possible, A => C => A )

Le but est de déterminer la somme de la lettre, de ses affiliés et de leurs affiliés etc....
Quelque chose qui pourrait correspondre à ton cas donc.

Essaies de te baser sur cet exemple.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
32
33
34
35
36
37
38
39
40
41
Option Explicit
 
Dim Rng As Range
Dim Rng2 As Range
Dim WS As Worksheet
Dim c As Range
 
Sub Calcul()
    Dim Ltr As String
    Dim WS As Worksheet
    Dim c As Range
    Dim Total As Long
 
    Set WS = ThisWorkbook.Worksheets("Feuil3")
    Total = 0
    Ltr = InputBox("Lettre")
 
    With WS
        Set Rng = .Range(.Cells(1, 1), .Cells(Fin(WS), 1))
        Set Rng2 = Rng.Offset(, 2)
        Total = Total + Rng.Find(Ltr, Lookat:=xlWhole).Offset(0, 1).Value
 
        For Each c In Rng2
            If c.Value = Ltr Then Total = Total + RchAff(c.Offset(0, -2).Value)
        Next c
    End With
 
    MsgBox Total
 
End Sub
 
Function RchAff(L As String) As Long
 
    RchAff = RchAff + Rng.Find(L, Lookat:=xlWhole).Offset(0, 1).Value
 
    For Each c In Rng2
        If c.Value = L Then RchAff = RchAff + RchAff(c.Offset(0, -2).Value)
    Next c
 
 
End Function

**GuiBar18** · 28/06/2012, 19h21

Merci pour l'exemple.
De mon côté j'ai fait une petite pause dans mes recherches. Comme toujours, c'est en pensant à tout autre chose que la solution vient :

C'est bête mais ma fonction ne retenais pas son propre résultat. Du coup, au passage dans une autre branche de l'arbre, hop, le résultat était remis à 0 ... ...

Eh oui, ce sont parfois les choses les plus évidentes qui nous passent sous le nez.
Pour info, voici le code général de la fonction (juste la fonction, la procédure est identique) avec en rouge et en gras ce qu'il manquait :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Dim r As Integer
'Définition de la fonction récursive
For r = 0 To (Taille - 1)
    If ListeValeur(r, 1) = Père Then
        Fils = ListeValeur(r, 0)
        Element_amont = Element_amont + ListeValeur(r, 2) + Element_amont(Fils, ListeValeur, Taille)
    Else: 'Dans les autres cas on ne fait rien
    End If
Next r
End Function

Pas grand chose donc.
Merci à tous ceux qui ont pu lre ce topic.

**AlphaScorpi** · 28/06/2012, 19h32

L'exemple adapté a ton fichier =)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
32
Option Explicit
 
Dim Rng As Range
Dim Rng2 As Range
Dim WS As Worksheet
Dim c As Range
 
Sub Calcul()
    Dim Ltr As String
    Dim WS As Worksheet
    Dim c As Range
    Dim Total As Long
    Set WS = ThisWorkbook.Worksheets("Feuil1")
    Total = 0
    Ltr = InputBox("Code")
    With WS
        Set Rng = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
        Set Rng2 = Rng.Offset(, 1)
        Total = Total + Rng.Find(Ltr, Lookat:=xlWhole).Offset(0, 2).Value
        For Each c In Rng2
            If c.Value = Ltr Then Total = Total + RchAff(c.Offset(0, -1).Value)
        Next c
    End With
    MsgBox Total
End Sub
 
Function RchAff(L As String) As Long
    RchAff = RchAff + Rng.Find(L, Lookat:=xlWhole).Offset(0, 2).Value
    For Each c In Rng2
        If c.Value = L Then RchAff = RchAff + RchAff(c.Offset(0, -1).Value)
    Next c
End Function

Au passage, désolé, j'ai laissé une fonction perso FIN() dans l'autre exemple, à remplacer par .Cells(.Rows.Count, 1).End(xlUp).Row

Fonction récursive en VBA [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager