VBA Formule personnalisée

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour,

Je souhaite rassembler dans un seul et même tableau les infos qui se trouvent dans des tableaux identiques qui se trouvent dans différents onglets.
Ce tableau de synthèse est différent des tableaux de données, c’est pourquoi je veux créer une formule qui récupèrera les données en fonctions des entêtes de colonnes ou de lignes.

Malheureusement ma formule de fonctionne pas et ne renvoie pas de valeur.
Pouvez-vous m’aider SVP ?

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
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
86
87
 
 
Function informationsPret2() As Double
 
Dim valeurAnnee As Long, valeurMois As String, valeurPret As String, valeurInfo As String
Dim feuille As String, derniereLigne As Long
Dim deplacementMois As Long, deplacementAnnee As Long
Dim valeurRecherchee As Double
 
Dim numeroColonne As Long
Dim numeroLigne As Long
Dim lettreColonneValeur As String
Dim plageAnnee As Range
Dim plageMois As Range
Dim colonneValeur As String
Dim plageRechercheValeurPret As String
 
Application.Volatile
 
numeroColonne = ActiveCell.Column
numeroLigne = ActiveCell.Row
 
 
 
lettreColonneValeur = Split(Cells(1, numeroColonne).Address, "$")(1)
 
Set plageAnnee = Range(lettreColonneValeur & 12)
Set plageMois = Range(lettreColonneValeur & 13)
 
valeurAnnee = plageAnnee.MergeArea.Cells(1, 1).Value
valeurMois = plageMois.MergeArea.Cells(1, 1).Value
valeurInfo = Range(lettreColonneValeur & 14).Value
valeurPret = Range("A" & numeroLigne).Value
 
feuille = valeurPret
 
 
If valeurInfo = " Remboursement Capital" Then
 
    colonneValeur = "C"
    deplacementMois = 6
    deplacementAnnee = 7
 
ElseIf valeurInfo = " Intérêts" Then
 
    colonneValeur = "D"
    deplacementMois = 5
    deplacementAnnee = 6
 
ElseIf valeurInfo = " Capital dû aprés échéance" Then
 
    colonneValeur = "F"
    deplacementMois = 3
    deplacementAnnee = 4
 
End If
 
derniereLigne = 0
 
Worksheets(feuille).Activate
 
Range("A" & Rows.Count).End(xlUp).Select
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row
 
plageRechercheValeurPret = colonneValeur & "12: L " & derniereLigne
 
Range(plageRechercheValeurPret).Select
 
 
For Each Cell In Selection
    Cell.Select
 
    If ActiveCell.Offset(0, deplacementAnnee).Value = valeurAnnee And ActiveCell.Offset(0, deplacementMois).Value = valeurMois Then
 
        valeurRecherchee = ActiveCell.Value
 
        Exit Function
 
    End If
 
Next Cell
 
 
informationsPret2 = valeurRecherchee
 
 
End Function

30/07/2019, 10h15
Tylert

Est ce que tu as utilisé les outils de debugging de VBA?
Tu peux placer un point d'arrêt dans ton code et regarder la valeur des variables.
Ainsi, tu peux voir à partir d'où ton code ne fait pas ce qui est attendu.

Il est difficile pour nous (ou peut etre seulement pour moi qui suis une grosse feignasse) de debugguer un code sans avoir la source des données (Il se peut que tu points sur une cellule vide à un moment par exemple, mais cela on ne peut le savoir sans le fichier). Avec le débuggueur tu as toutes les infos necessaire pour voir ce qui ne vas pas.

Bon courage!
30/07/2019, 10h24
Menhir

Je n'ai pas analysé tout ton code mais je pense que tu confonds Exit Function avec Exit For.

Autre détail : pour moi, une fonction ne doit servir qu'à renvoyer une valeur et ne doit pas réaliser d'actions.
Les Activate et Select que tu y as mis n'ont donc rien à y faire.
D'autant plus que ton Activate pourra être supprimé au profit d'un With et que les Select sont au mieux inutiles et au pire compliquent ton code.
30/07/2019, 10h38
Tylert

Citation:

Envoyé par Menhir

Je n'ai pas analysé tout ton code mais je pense que tu confonds Exit Function avec Exit For.

Autre détail : pour moi, une fonction ne doit servir qu'à renvoyer une valeur et ne doit pas réaliser d'actions.
Les Activate et Select que tu y as mis n'ont donc rien à y faire.
D'autant plus que ton Activate pourra être supprimé au profit d'un With et que les Select sont au mieux inutiles et au pire compliquent ton code.

Effectivement, Si tu quittes la fonction avant d'assigner la valeur de retour, ca ne retourne rien :)
Je pense que c'est la bonne piste! (Et tu aurais vu cela avec le débuggeur).

J'ai remanié mon code pour le rendre un peu plus lisible.
Mais rien n'y fait.
La cellule ne renvoie pas la valeur recherchée.

Je n'ai pas trop compris comment remplacer mon "Activate" par "With".

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
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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Public valeurAnnee As Long, valeurMois As String, valeurPret As String, valeurInfo As String
Public feuille As String, derniereLigne As Long
Public deplacementMois As Long, deplacementAnnee As Long
Public valeurRecherchee As Double
 
Function informationsPret() As Double
 
Application.Volatile
 
Call renseignementColonne
Call rechercheValeurPret
 
 
informationsPret = valeurRecherchee
 
 
End Function
Sub renseignementColonne()
 
Dim numeroColonne As Long
Dim numeroLigne As Long
Dim lettreColonneValeur As String
Dim plageAnnee As Range
Dim plageMois As Range
 
numeroColonne = ActiveCell.Column
numeroLigne = ActiveCell.Row
 
lettreColonneValeur = lettreColonne(numeroColonne)
 
Set plageAnnee = Range(lettreColonneValeur & 12)
Set plageMois = Range(lettreColonneValeur & 13)
 
valeurAnnee = plageAnnee.MergeArea.Cells(1, 1).Value
valeurMois = plageMois.MergeArea.Cells(1, 1).Value
valeurInfo = Range(lettreColonneValeur & 14).Value
valeurPret = Range("A" & numeroLigne).Value
 
feuille = valeurPret
 
'MsgBox (valeurAnnee & valeurMois & valeurPret)
 
End Sub
 
Function lettreColonne(numeroColonneAConvertir)
 
lettreColonne = Split(Cells(1, numeroColonneAConvertir).Address, "$")(1)
 
End Function
 
Sub rechercheValeurPret()
 
Dim colonneValeur As String
Dim plageRechercheValeurPret As String
 
 
Worksheets(feuille).Activate
 
If valeurInfo = " Remboursement Capital" Then
 
    colonneValeur = "C"
    deplacementMois = 6
    deplacementAnnee = 7
 
ElseIf valeurInfo = " Intérêts" Then
 
    colonneValeur = "D"
    deplacementMois = 5
    deplacementAnnee = 6
 
ElseIf valeurInfo = " Capital dû aprés échéance" Then
 
    colonneValeur = "F"
    deplacementMois = 3
    deplacementAnnee = 4
 
End If
 
Call compteurLignes(feuille, "A")
 
plageRechercheValeurPret = colonneValeur & "12:L" & derniereLigne
 
Range(plageRechercheValeurPret).Select
 
 
For Each Cell In Selection
    Cell.Select
 
    If ActiveCell.Offset(0, deplacementAnnee).Value = valeurAnnee And ActiveCell.Offset(0, deplacementMois).Value = valeurMois Then
 
        valeurRecherchee = ActiveCell.Value
 
        Exit For
 
    End If
 
Next Cell
 
End Sub
 
 
Sub compteurLignes(feuilleCompteur As String, colonneCompteur As String)
 
 
derniereLigne = 0
 
Worksheets(feuilleCompteur).Activate
 
Range(colonneCompteur & Rows.Count).End(xlUp).Select
derniereLigne = Range(colonneCompteur & Rows.Count).End(xlUp).Row
 
End Sub

30/07/2019, 12h11
Tylert

Ton code passe la compilation et se base sur un formatage d'une ou plusieurs feuilles de ton classeur. Donc, comme je te l'ai dit plus haut, sans le classeur, difficile de dire pourquoi ton code ne marche pas.

Essaye de débuguer...

sinon es tu sur des valeurs de valeurInfo? tu met des espaces devant les mots à chaqque fois. ca parait bizzare. Peut etre qu'ici tu ne rentres dans aucune condition....
30/07/2019, 12h27
Menhir

Citation:

Envoyé par fnallet94

J'ai remanié mon code pour le rendre un peu plus lisible.
Mais rien n'y fait.
La cellule ne renvoie pas la valeur recherchée.

C'est normal. Tu corriges une erreur mais tu en crées une autre (pour une raison qui m'échappe d'ailleurs).
Si tu supprimes informationsPret2 = ..., ta fonction ne risque pas de renvoyer quoi que ce soit.
30/07/2019, 13h38
Tylert

Citation:

Envoyé par Menhir

C'est normal. Tu corriges une erreur mais tu en crées une autre (pour une raison qui m'échappe d'ailleurs).
Si tu supprimes informationsPret2 = ..., ta fonction ne risque pas de renvoyer quoi que ce soit.

A priori tous les retours de fonction sont pris en compte, mais je ne vois pas de informationsPret2 dans le code... tu es sur de ton coup?
30/07/2019, 14h17
Invité

1 pièce(s) jointe(s)

Pièce jointe 494501

Les variables s'alimentent.
Mais la cellule ou est renseignée la formule n'affiche pas la valeur trouvée.

Entre temps, j'ai modifié les erreurs de code.
30/07/2019, 14h32
Menhir

Citation:

Envoyé par Tylert

je ne vois pas de informationsPret2 dans le code...

C'est bien pour ça que la fonction qui porte ce nom ne renvoie rien.
Dans le premier code, il y était et c'était nécessaire. En le retirant, tu as ajouté une erreur.
A ton avis, qu'est-ce qui indique la valeur que doit renvoyer la fonction ?

Citation:

Envoyé par Menhir

C'est bien pour ça que la fonction qui porte ce nom ne renvoie rien.
A ton avis, qu'est-ce qui indique la valeur que doit renvoyer la fonction ?

La fonction a changé de nom dans la 2em version de code :) elle ne s'appelle plus informationsPret2, mais informationsPret...
et tu as bien : informationsPret = valeurRecherchee dans la fonction.

enfin je dis ca, je dis rien :D

Sinon j'ai fait un petit test:
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 Public valeurAnnee As Long, valeurMois As String, valeurPret As String, valeurInfo As String Public feuille As String, derniereLigne As Long Public deplacementMois As Long, deplacementAnnee As Long Public valeurRecherchee As Double Function informationsPret() As Double Application.Volatile renseignementColonne recherchevaleurpret informationsPret = valeurRecherchee End Function Sub renseignementColonne() valeurRecherchee = 1111 End Sub Sub recherchevaleurpret() valeurRecherchee = 2222 End Sub
Ici la cellule a pour valeur 2222.
C'est a priori, autre part qu'est le probleme.

1 pièce(s) jointe(s)

Concernant les changements de noms de variables, tout a été corrigé , il n y a pas de soucis (A moins que je deviens fatigué).

La fonction "informationsPret2" prend bien la valeur de la variable "valeurRecherchee" (voir image)

Pièce jointe 494600

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
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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Public valeurAnnee As Long, valeurMois As String, valeurPret As String, valeurInfo As String
Public feuille As String, derniereLigne As Long
Public deplacementMois As Long, deplacementAnnee As Long
Public valeurRecherchee As Double
 
Function informationsPret2() As Double
 
Application.Volatile
 
Call renseignementColonne
Call rechercheValeurPret
 
 
informationsPret2 = valeurRecherchee
 
 
End Function
Sub renseignementColonne()
 
Dim numeroColonne As Long
Dim numeroLigne As Long
Dim lettreColonneValeur As String
Dim plageAnnee As Range
Dim plageMois As Range
 
numeroColonne = ActiveCell.Column
numeroLigne = ActiveCell.Row
 
lettreColonneValeur = lettreColonne(numeroColonne)
 
Set plageAnnee = Range(lettreColonneValeur & 12)
Set plageMois = Range(lettreColonneValeur & 13)
 
valeurAnnee = plageAnnee.MergeArea.Cells(1, 1).Value
valeurMois = plageMois.MergeArea.Cells(1, 1).Value
valeurInfo = Range(lettreColonneValeur & 14).Value
valeurPret = Range("A" & numeroLigne).Value
 
feuille = valeurPret
 
'MsgBox (valeurAnnee & valeurMois & valeurPret)
 
End Sub
 
Function lettreColonne(numeroColonneAConvertir)
 
lettreColonne = Split(Cells(1, numeroColonneAConvertir).Address, "$")(1)
 
End Function
 
Sub rechercheValeurPret()
 
Dim colonneValeur As String
Dim plageRechercheValeurPret As String
 
 
Worksheets(feuille).Activate
 
If valeurInfo = " Remboursement Capital" Then
 
    colonneValeur = "C"
    deplacementMois = 6
    deplacementAnnee = 7
 
ElseIf valeurInfo = " Intérêts" Then
 
    colonneValeur = "D"
    deplacementMois = 5
    deplacementAnnee = 6
 
ElseIf valeurInfo = " Capital dû aprés échéance" Then
 
    colonneValeur = "F"
    deplacementMois = 3
    deplacementAnnee = 4
 
End If
 
Call compteurLignes(feuille, "A")
 
plageRechercheValeurPret = colonneValeur & "12:L" & derniereLigne
 
Range(plageRechercheValeurPret).Select
 
 
For Each Cell In Selection
    Cell.Select
 
    If ActiveCell.Offset(0, deplacementAnnee).Value = valeurAnnee And ActiveCell.Offset(0, deplacementMois).Value = valeurMois Then
 
        valeurRecherchee = ActiveCell.Value
 
        Exit For
 
    End If
 
Next Cell
 
End Sub
 
 
Sub compteurLignes(feuilleCompteur As String, colonneCompteur As String)
 
 
derniereLigne = 0
 
Worksheets(feuilleCompteur).Activate
 
Range(colonneCompteur & Rows.Count).End(xlUp).Select
derniereLigne = Range(colonneCompteur & Rows.Count).End(xlUp).Row
 
End Sub

30/07/2019, 17h47
Invité

2 pièce(s) jointe(s)

Tableau de synthese :

Pièce jointe 494605

Tableau de données :

Pièce jointe 494608
31/07/2019, 10h09
Tylert

Peux tu mettre ton classeur de test en pièce jointe?
31/07/2019, 10h29
Invité

1 pièce(s) jointe(s)

Piece jointe.

Merci
31/07/2019, 11h21
Tylert
Y'a déjà un problème dans ton code:
Code:

1 2 3 numeroColonne = ActiveCell.Column numeroLigne = ActiveCell.Row
Il faut que tu saches que toutes les formules sont recalculées quand tu changes quelque chose dans la feuille et la, ta fonction utilise la cellule active... du coup toutes les cases ont la même valeur...
Il faut donc trouver comment adresser la case ou se trouve l'instance de ta formule en cours de recalcul...

Est ce qu'il existe une properties pour l'objet application qui adresse la cellule dans laquelle on est en train de recalculer la formule? je ne trouve pas dans la doc Microsoft.

Bonjour à tous,

Citation:

Il faut donc trouver comment adresser la case ou se trouve l'instance de ta formule en cours de recalcul...

ThisCell est la cellule appelante. Donc :
Code:

1 2 3 4 5 6 7 8 'Nom classeur : Application.ThisCell.Parent.Parent.Name 'Nom feuille : Application.ThisCell.Parent.Name 'Adresse cellule d'appel : Application.ThisCell.Address 'Plage cellules d'appel matricielle: Application.Caller.Cells
eric

01/08/2019, 10h57
Invité

Merci a vous tous.
Je test et reviens vers vous.

1 pièce(s) jointe(s)

Le résultat du calcul de la formule dans la cellule est bien reporté.
Mais elle ne se réinitialise pas, et donne la même valeur a toutes les autres cellules.
Je pense que la valeur d Application.ThisCell.Adress ne se recalcul pas

Pièce jointe 494932

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
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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Public valeurAnnee As Long, valeurMois As String, valeurPret As String, valeurInfo As String
Public feuille As String, derniereLigne As Long, derniereColonne As Long
Public deplacementMois As Long, deplacementAnnee As Long
Public valeurRecherchee As Double
Public ligneTarget As Long
Public colonneTarget As Long
Public AdCell As String
 
 
Function informationsPret2() As Double
 
 
Application.ScreenUpdating = False
 
 
AdCell = Application.ThisCell.Address
 
Application.Volatile
 
Call renseignementColonne
Call rechercheValeurPret
 
 
informationsPret2 = valeurRecherchee
 
End Function
 
Sub renseignementColonne()
 
 
Dim numeroLigne As Long
Dim lettreColonneValeur As String
Dim plageAnnee As Range
Dim plageMois As Range
 
 
lettreColonneValeur = Split(AdCell, "$")(1)
numeroLigne = Split(AdCell, "$")(2)
 
 
Set plageAnnee = Range(lettreColonneValeur & 12)
Set plageMois = Range(lettreColonneValeur & 13)
 
valeurAnnee = plageAnnee.MergeArea.Cells(1, 1).Value
valeurMois = plageMois.MergeArea.Cells(1, 1).Value
valeurInfo = Range(lettreColonneValeur & 14).Value
valeurPret = Range("A" & numeroLigne).Value
 
feuille = valeurPret
 
 
End Sub
 
 
Sub rechercheValeurPret()
 
Dim colonneValeur As String
Dim plageRechercheValeurPret As String
 
 
Worksheets(feuille).Activate
 
If valeurInfo = " Remboursement Capital" Then
 
    colonneValeur = "C"
    deplacementMois = 6
    deplacementAnnee = 7
 
ElseIf valeurInfo = " Intérêts" Then
 
    colonneValeur = "D"
    deplacementMois = 5
    deplacementAnnee = 6
 
ElseIf valeurInfo = " Capital dû aprés échéance" Then
 
    colonneValeur = "F"
    deplacementMois = 3
    deplacementAnnee = 4
 
End If
 
Call compteurLignes(feuille, "A")
 
plageRechercheValeurPret = colonneValeur & "12:" & colonneValeur & derniereLigne
 
Range(plageRechercheValeurPret).Select
 
 
For Each Cell In Selection
    Cell.Select
 
    If Cell.Offset(0, deplacementAnnee).Value = valeurAnnee And Cell.Offset(0, deplacementMois).Value = valeurMois Then
 
        valeurRecherchee = Cell.Value
        Exit For
 
    End If
 
Next Cell
 
End Sub
 
 
Sub compteurLignes(feuilleCompteur As String, colonneCompteur As String)
 
derniereLigne = 0
 
Worksheets(feuilleCompteur).Activate
 
derniereLigne = Range(colonneCompteur & Rows.Count).End(xlUp).Row
 
End Sub

01/08/2019, 13h50
Tylert
Y'a pas un autre problème:
Code:

1 2 3 4 5 6 Range(plageRechercheValeurPret).Select For Each Cell In Selection Cell.Select
La selection de la plage est ecrasée par la selection de la cellule?
du coup, ta boucle ne fonctionne que pour la 1ere cellule de ta selection je pense.
Chez moi, on sort de la boucle après la 1ere itération.

sinon, le thiscell.address fonctionne chez moi sous office 365.

Voir 40 message(s) de cette discussion en une page