transformer une macro en une fonction perso
Le
isabelle

bonjour à tous,
je peux trouver la variable r valant entre 0.01 à 0.9999999999999 pour résoudre
toute équation égale à 0
avec la macro "test" mais je n'y arrive pas avec un fonction perso,
voici ma solution avec une macro et j'aimerais la transformer en une fonction
générale,
Sub test()
Dim i, z, a1, a2, r
FVt = 210
PV1 = 100
PV2 = 101
t1 = 0.5
t2 = 0.75
a1 = "0.0"
For i = 0 To 9
r = CDbl(Str("" & a1 & i))
z = Exp(Application.Ln((FVt - PV1 * (1 + r) ^ t1) / PV2) / t2) - 1 - r
If z < 0 Then
a1 = Str("" & a1 & i - 1)
i = Empty
If a2 = z Then Exit For
End If
a2 = z
Next
MsgBox CDbl(a1)
End Sub
voici ou je suis rendu en utilisant Evaluate et des cellules nommées, mais ce
n'est pas bon
Function r_value(FVt, PV1, PV2, t1, t2, r, equation)
a1 = [r]
For i = 0 To 9
[r_v] = CDbl(Str("" & a1 & i))
z = Evaluate(equation)
If z < 0 Then
a1 = Str("" & a1 & i - 1)
i = Empty
If a2 = z Then Exit For
End If
a2 = z
Next
r_value = CDbl(a1)
End Function
merci par avance de passer du temps sur mon problème,
isabelle
je peux trouver la variable r valant entre 0.01 à 0.9999999999999 pour résoudre
toute équation égale à 0
avec la macro "test" mais je n'y arrive pas avec un fonction perso,
voici ma solution avec une macro et j'aimerais la transformer en une fonction
générale,
Sub test()
Dim i, z, a1, a2, r
FVt = 210
PV1 = 100
PV2 = 101
t1 = 0.5
t2 = 0.75
a1 = "0.0"
For i = 0 To 9
r = CDbl(Str("" & a1 & i))
z = Exp(Application.Ln((FVt - PV1 * (1 + r) ^ t1) / PV2) / t2) - 1 - r
If z < 0 Then
a1 = Str("" & a1 & i - 1)
i = Empty
If a2 = z Then Exit For
End If
a2 = z
Next
MsgBox CDbl(a1)
End Sub
voici ou je suis rendu en utilisant Evaluate et des cellules nommées, mais ce
n'est pas bon
Function r_value(FVt, PV1, PV2, t1, t2, r, equation)
a1 = [r]
For i = 0 To 9
[r_v] = CDbl(Str("" & a1 & i))
z = Evaluate(equation)
If z < 0 Then
a1 = Str("" & a1 & i - 1)
i = Empty
If a2 = z Then Exit For
End If
a2 = z
Next
r_value = CDbl(a1)
End Function
merci par avance de passer du temps sur mon problème,
isabelle
merci!
isabelle
Chez moi, ta macro bloque à cette ligne :
r = CDbl(Str("" & a1 & i))
Pourquoi tu écris ceci comme ça :
a1 = "0.0"
Qu'est-ce que ces 2 lignes de code sont supposées d'accomplir?
Le 2014-03-18 21:16, MichD a écrit :
cela ne parait pas à la première boucle car
r = CDbl(Str("" & a1 & i))
r=0
mais à la deuxième boucle
r=0.01
au 3èm
r=0.02
et au 4èm
r=0.03
etc.
dans cet exemple lorsque r = 0.08
z est < 0 alors on reduit r = 0.07
et au prochain passage
r = 0.071
ainsi de suite
je ne comprend pas pourquoi chez toi ça bloque sur
r = CDbl(Str("" & a1 & i))
as-tu essayé avec
r = CDbl(Str(a1 & i))
isabelle
est-ce qu'elle retourne la valeur que tu cherches?
B ) Pourquoi ne pas prendre le temps de déclarer le type des variables
Tu allonges indûment le temps de traitement!
C ) Maintenant dans la fonction que tu as publiée, il y a des trucs bizarres
pour moi.
1 - J'ai modifié cette ligne de code comme dans la procédure :
a1 = CDbl(a1 - (i / 100))
2 - quand tu écris ceci : MsgBox r_value(FVt, PV1, PV2, ti, T2, r,
équation)
équation est une plage nommée dans ton classeur et si tu l'écris de
cette manière, équation = ""
À la place, j'aurais attribué directement au nom Équation l'équation :
Nom : Équation
Fait référence à : =EXP(LN((Feuil1!FVt-Feuil1!PV_1*(1+
r_v )^Feuil1!t_1)/Feuil1!PV_2)/Feuil1!t_2)-1- r_v
Et pour l'appel de la fonction, tu extrais la valeur du nom comme ceci :
X = Names("équation").RefersTo
X = Right(X, Len(X) - 1)
Et la ligne d'appel de la fonction comme ceci :
MsgBox r_value(FVt, PV1, PV2, ti, T2, r, X)
3 - [r_v] = CDbl(a1 - (i / 100))
R_V est un nom "NAME" qui réfère à une valeur .01
- A ) Tu ne peux pas modifier la valeur du nom de cette manière
- B ) Si tu modifies la valeur du nom, qu'est-ce qui se passe lors du
prochain appel
de la fonction
- C ) Pour modifier la valeur du nom "R_V" dans ta fonction, tu dois
utiliser quelque
chose comme ceci :
v = CDbl(a1 - (i / 100))
Names.Add Name:=("r_v"), RefersTo:=v
Si tu apportes ces modifications, la fonction va rouler...
La question va devenir, est-ce qu'elle retourne le résultat attendu????
La procédure fonctionne chez moi, écrite de cette manière.
'-----------------------------------------------------------------
Sub test()
Dim i As Double, z As Double, a1 As Double, a2 As Double, r As Double
Dim FVt As Long, FV1 As Long, PV2 As Long, t1 As Double, T2 As Double
Range("E2") = 0
FVt = 210
PV1 = 100
PV2 = 101
t1 = 0.5
T2 = 0.75
a1 = 0#
For i = 0 To 9
r = CDbl(a1 + (i / 100)) '<<<<<<<<=========MODIFIER
z = Exp(Application.Ln((FVt - PV1 * (1 + r) ^ t1) / PV2) / T2) - 1 - r
If z < 0 Then
a1 = CDbl(a1 - (i / 100)) '<<<<<<<<=========MODIFIER
i = Empty
If a2 = z Then Exit For
End If
a2 = z
Next
MsgBox CDbl(a1)
Range("E2") = CDbl(a1)
End Sub
'-----------------------------------------------------------------
non la bon résultat est 0.0724582318483
je le fait une fois que tout la macro est terminé
c'est ce que j'ai fait, regarde la cellule B6
à ce moment la variable r n'est pas connue, donc l'équation ne pas peut fonctionné
bonne idé, je vais tester
merci Denis
j'ai modifié la macro pour n'utiliser que des chiffres et des cellules nommées
et j'ai ajouté un nom r_v = 0
j'ai pris ton idée ( 1/100) et Names("r_v").RefersTo
http://cjoint.com/?DCtseIPpB5Q
la macro fonctionne bien,
mais la fonction ne fonctionne pas, je crois qu'une fonction ne peut pas
modifier la valeur d'un "Nom"
Sub test2()
Dim i, z, a1, a2, r, x
Names("r_v").RefersTo = 0
x = 1
q = [équation]
For i = 0 To 9
If i = 0 Then x = x + 1: b = 1 * 10 ^ x
Names("r_v").RefersTo = [r_v] + (1 / b)
z = Evaluate(q)
If z < 0 Then
If a2 = z Then Exit For
i = Empty
Names("r_v").RefersTo = [r_v] - (1 / b)
If i = 0 Then x = x + 1: b = 1 * 10 ^ x
End If
a2 = z
Next
MsgBox Format([r_v], "0.00000000000000")
End Sub
Function r_value(FVt, PV1, PV2, t1, t2, équation)
Dim i, z, x, b, a1
Names("r_v").RefersTo = 0
x = 1
q = [équation]
For i = 0 To 9
If i = 0 Then x = x + 1: b = 1 * 10 ^ x
Names("r_v").RefersTo = [r_v] + (1 / b)
z = Evaluate(q)
If z < 0 Then
If a1 = z Then Exit For
i = Empty
Names("r_v").RefersTo = [r_v] - (1 / b)
If i = 0 Then x = x + 1: b = 1 * 10 ^ x
End If
a1 = z
Next
r_value = [r_v]
End Function
J'ai ajouté un paramètre "R_V" à l'appel de la fonction.
Au lieu de définir une valeur numérique au NOM R_V, je lui
ai attribué l'adresse de la cellule A7. Et ça roule!
J'ai adapté légèrement la syntaxe de la fonction pour qu'elle
tienne compte de cette modification...
'---------------------------------------------
Function r_value(R_V, FVt, PV1, PV2, t1, t2, équation)
Dim i, z, x, b, a1
[R_V] = 0
x = 1
q = [équation]
For i = 0 To 9
If i = 0 Then x = x + 1: b = 1 * 10 ^ x
[R_V] = [R_V] + (1 / b)
z = Evaluate(q)
If z < 0 Then
If a1 = z Then Exit For
i = Empty
[R_V] = [R_V] - (1 / b)
If i = 0 Then x = x + 1: b = 1 * 10 ^ x
End If
a1 = z
Next
r_value = [R_V]
End Function
'---------------------------------------------
=r_value(FVt;PV_1;PV_2;t_1;t_2;équation)
j'obtient #VALEUR! même en attribuant l'adresse de la cellule $A$7 au nom R_V
:-(
isabelle
Le 2014-03-19 14:29, MichD a écrit :
il doit être de 0.0724582318483012
sur le fichier que tu as joint le résultat est à 0.1000000000
Le 2014-03-19 17:21, MichD a écrit :