Function deg3c(c As Range, Optional b# = 0) 'c : plage de quatre cellules contigües , b valeur approchée de la racine cherchée.
ReDim a#(1 To 4)
Dim i%, p#, q#, r#, rx1#, rx2#, rx3#, ix2#, ix3#
For i = 2 To 4: a(i) = c(i) / c(1): Next
p = a(2) ^ 2 / 9 - a(3) / 3
q = a(2) * a(3) / 6 - a(2) ^ 3 / 27 - a(4) / 2
r = q ^ 2 - p ^ 3
If r < 0 Then
r = WorksheetFunction.Acos(q / Sqr(p ^ 3)) / 3
rx1 = Sqr(p) * Cos(r + 2.0943951023932) * 2 '2*pi/3 = 2.0943951023931954923084289221863
rx2 = Sqr(p) * Cos(r - 2.0943951023932) * 2
rx3 = Sqr(p) * Cos(r) * 2
Else
r = Sqr(r)
p = Sgn(q + r) * Abs(q + r) ^ (1 / 3)
q = Sgn(q - r) * Abs(q - r) ^ (1 / 3)
rx1 = q + p
rx2 = -rx1 / 2
ix2 = Sqr(3) * (q - p) / 2
rx3 = rx2
ix3 = -ix2
End If
rx1 = rx1 - a(2) / 3
rx2 = rx2 - a(2) / 3
rx3 = rx3 - a(2) / 3
Select Case (Abs(b - rx1) < Abs(b - rx2)) + 2 * (Abs(b - rx1) < Abs(b - rx3)) + 4 * (Abs(b - rx2) < Abs(b - rx3))
Case 0, -2: r = rx3: rx3 = rx1: rx1 = r
Case -1: r = rx3: rx3 = rx2: rx2 = rx1: rx1 = r
Case -3: r = rx3: rx3 = rx2: rx2 = r
Case -4: r = rx3: rx3 = rx1: rx1 = rx2: rx2 = r
Case -6: r = rx2: rx2 = rx1: rx1 = r
End Select
deg3c = Array(rx1, rx2, ix2, rx3, ix3)
End Function