Function deg3b(a#, ByVal b#, c#, d#)
Dim p#, q#, r#, rex1#, rex2#, rex3#, imx2#, imx3#
'On veut résoudre : a*x^3+b*x^2+c*x+d=0 ; a<>0 (1)
'On met (1) sous la forme canonique y^3-3*p*y-2*q=0 (2)
'en posant x=y-b/a/3 (3)
'Il vient :
'a*(y-b/a/3)^3+b*(y-b/a/3)^2+c*(y-b/a/3)+d=0
'Après développement et réduction :
'y^3-3*((b/a/3)^2-c/a/3)*y-2*((b/a/3)^3+b/a/3*c-d)/a/2=0
'Avec :
b = b / a / 3
'y^3-3*(b^2-c/a/3)*y-2*(b^3+(b*c-d)/a/2)=0 (4)
'D'où :
p = b ^ 2 - c / a / 3
q = (b * c - d) / a / 2 - b ^ 3
'Il faut maintenant résoudre : y^3-3*p*y-2*q=0
'La méthode à employer dépend du signe de q^2-p^3 (5) ("discriminant" de l'équation)
r = q ^ 2 - p ^ 3
If r < 0 Then 'Trois racines réelles.
r = WorksheetFunction.Acos(q / Sqr(p ^ 3)) / 3 'Valable car r<0 => Abs(q/Sqr(p^3))<1
rex1 = Sqr(p) * Cos(r + 2.0943951023932) * 2 '2*pi/3 = 2.0943951023931954923084289221863
rex2 = Sqr(p) * Cos(r - 2.0943951023932) * 2
rex3 = Sqr(p) * Cos(r) * 2
Else 'Une racine réelle et deux racines complexes conjuguées si r>0.
'Trois racines réelles dont une double si r=0.
r = Sqr(r)
p = Sgn(q + r) * Abs(q + r) ^ (1 / 3)
q = Sgn(q - r) * Abs(q - r) ^ (1 / 3)
rex1 = q + p
rex2 = -rex1 / 2
imx2 = Sqr(3) * (q - p) / 2
rex3 = rex2
imx3 = Sqr(3) * (p - q) / 2
End If
'À ce stade, on a les racines de (2) : y1=rex1, y2=rex2+i*imx2, y3=rex3+i*imx3
'Compte tenu de (3), on termine :
rex1 = rex1 - b
rex2 = rex2 - b
rex3 = rex3 - b
'Renvoi des racines sous forme de tableau :
deg3b = Array(rex1, rex2, imx2, rex3, imx3)
'Pour récupérer les résultats :
'- On suppose les données a, b, c, d en A2:D2.
'1. Sélectionner cinq cellules contigües dans une ligne.
'Saisir =deg3c(A2;B2;C2;D2) dans la première et valider matriciellement ( Ctrl Maj Entrée ).
'2. Sélectionner cinq cellules contigües dans une colonne.
'Saisir =TRANSPOSE(deg3c(A2;B2;C2;D2)) dans la première et valider matriciellement ( Ctrl Maj Entrée ).
'3. Pour afficher une des cinq valeurs, saisir =INDEX(deg3c(A2;B2;C2;D2);n), avec n entier de 1 à 5.
'
'Remarques :
'1. Il convient que a<>0. (Sinon l'équation est de degré 2.)
'2. Si d=0 l'une au moins des racines est nulle. Les deux autres sont les racines de :
'a*x^2+b*x+c=0
End Function