Dim e#, h#, p()
Const a# = -0.0054
Const b# = -0.1701
Const c# = 8.3121
Const d# = 0.478
Sub param()
p = Feuille01.[B7:B9].Value 'À adapter selon
' l'endroit où se trouvent les paramètres.
e = d * p(2, 1) * p(1, 1) ^ -4.75 * 1000 ^ 1.75
h = p(3, 1)
End Sub
Function f#(x#)
' Écrire ici l'équation de la première fonction.
' Dans cet exemple, la première fonction s'écrit
' =-0,0054*PUISSANCE(C3;2)-0,1701*C3+8,3121
' en formule Excel. La variable est C3. L'équation
' est celle d'une parabole dont l'équation s'écrit
' f(x)= a*x^2+b*x+c
' avec a=-0.0054, b=-0.1701, c=8.3121.
' (ou f(x)= c+x*(b+x*a) en appliquant le schéma de
' Hörner. Sous cette forme, le calcul ne nécessite
' que deux multiplications et deux additions ;
' il n'y a pas d'élévation à la puissance deux :
' c'est beaucoup plus rapide et souvent plus précis.)
' Par commodité, j'ai déclaré ces paramètres comme
' constantes en tête du module.
f = c + x * (b + x * a)
End Function
Function g#(x#)
' Écrire ici l'équation de la deuxième fonction.
' Dans cet exemple, elle s'écrit
' =$B$9+47,8*PUISSANCE($B$7;-4,75)*PUISSANCE((C3*1000);1,75)*$B$8/100
' en formule Excel. La variable est C3. L'équation
' est celle d'une fonction puissance dont, après
' simplification,l'équation s'écrit
' g(x)= e*x^1.75+h
' avec e=47,8*PUISSANCE($B$7;-4,75)*PUISSANCE(1000;1,75)*$B$8/100
' et h=$B$9.
' Comme la fonction g est utilisée à plusieurs reprises,
' j'ai déclaré les paramètres e et h en tête du
' module et je les calcul une seule fois dans la procédure
' 'param()'. Cela accélére les calculs.
g = h + e * x ^ 1.75
End Function
' Il n'y a rien à modifier dans ce qui suit.
Private Function Fonction#(x#)
Fonction = f(x) - g(x)
End Function
'
Function AnnuleFonction(inf#, sup#)
Application.Volatile 'Facultatif, en fonction de l'usage.
' Les paramètres inf et sup indique les bornes
' entre lesquelles on cherche une solution.
Dim x0#, x1#, f0#, f1#, h#, k#
param
f0 = Fonction(CDbl(inf))
f1 = Fonction(CDbl(sup))
If f0 = 0 Then
AnnuleFonction = inf
ElseIf f1 = 0 Then
AnnuleFonction = sup
ElseIf f1 * f0 > 0 Then
AnnuleFonction = Evaluate("=NA()")
Else
If f1 > f0 Then k = 1 Else k = -1
x0 = inf
x1 = sup
h = x1 - x0
Do
f1 = Fonction(x1)
h = h / 2
x0 = x1
If f1 > 0 Then x1 = x1 - k * h Else x1 = x1 + k * h
f0 = f1
Loop While h > 1E-20 And f0 <> 0
AnnuleFonction = x0
End If
End Function