Dim CelCbl As Range, CelSrc As Range, Valeur As Double, Z As String, XSvg As Double, PrécAt As Double, Rép As VbMsgBoxResult, J As Long
…
Set CelCbl = …
…
If Not CelCbl.HasFormula Then
…
If Not CelCbl.GoalSeek(Goal:=Valeur, ChangingCell:=CelSrc) Then
Rép = MsgBox("GoalSeek impuissant." & vbLf & "Voulez vous restaurer " …
…
For J = 1 To 5: ApprocherMieux CelCbl, Valeur, CelSrc, (J Mod 2 - 0.5) * 2# ^ (-5 * J): Next J
…
End Sub
Sub ApprocherMieux(ByVal CelCbl As Range, ByVal Valeur As Double, ByVal CelSrc As Range, ByVal Ajout As Double)
Dim X1 As Double, Y1 As Double, X2 As Double, Y2 As Double
X1 = CelSrc.Value: On Error GoTo Resto: Y1 = CelCbl.Value
X2 = X1 + Ajout: CelSrc.Value = X2: Y2 = CelCbl.Value
If Y2 <> Y1 Then
CelSrc.Value = X1 + (X2 - X1) * (Valeur - Y1) / (Y2 - Y1)
If Abs(CelCbl.Value - Valeur) < Abs(Y1 - Valeur) Then Exit Sub
End If
Resto: CelSrc.Value = X1
End Sub