INCREMENTER UNE FONCTION SOUS VBA EXCEL

[Nabafima]

Bonjour les genies qui sauvent le monde,

Je veux comprendre comment calculer en boucle la ou les solution(s) d'une fonction par la methode suivante:

La méthode consiste à introduire une suite (xn) d’approximation successives de l’équation f (x) = 0 (Dans mon cas cellule B2) .
• On part d’un x0 proche de la solution (Dans mon cas cellule B1) .
• À partir de x0, on calcule un nouveau terme x1 (Dans mon cas cellule B6) .
• On réitère ce procédé en calculant x2 en remplaçant x0 par x1, puis x3 en remplaçant
x1 par x2 et ainsi de suite . . .
Je prends comme critère d’arrêt pour une précision de epsilon ((Dans mon cas cellule B4).
Pour que ma suite existe ( du mois le calcul de recurence se fasse) il faut que F' soit non nul. Pour ce fait je met une condition ( dite de tolerance (Dans mon cas cellule B4).)) pour dire que en dessous de cette valeur, je ne fait pas le calcul de xn et je l'approxime à la valeur de x0

Esperant que quelqu'un m'aide sur cette problematique. J'espere que j'ai ete aussi clair.
J'ai joint le fichier excel avec la macro où j'ai ete bloqué car je ne sais pas comment faire la boucle avec l'incrementation.


Je vous remercie pour votre retour.

 

[Hieu]

Salut Nabafima,

D'apres les images que tu as faites (matlab, si je ne me trompe pas ?!), tu veux faire une boucle tant que :

Do while toto > titi 
... ' code
Loop

PS : ce post ressemble bcp à Newton Raphson, précédent ?

 

[Nabafima]

c'est bien ca J'ai fait avec le
Do while toto > titi
... ' code
Loop
je n'arrivais pas à calculer sauf avec le
Do
... ' code
Loop while toto > titi

A chauqye fois j'ai limpression qu'il ne prenne en compte que ma premiere valeur ... il ya quelque chose qui m'echape
Que ca soit une boucle for ( en forçcant ) ou une boucle tant que m'est egale

 

[Hieu]

Hum,
Je pense qu'il faut mettre L0 = L1 dans la boucle.
Pas sûr de comprendre bien ce que tu cherches à faire :

Sub TEST_BOUCLE()
'========================== DECLARATION DES VARIABLES ======================
' Dim tolerance As Double                      ' Precision souhaitée
' Dim Espilon As Double                       ' Le nombre le plus petit qu'il faudrait
' Dim L0 As Double                             ' Valeur initiale de L0
' Dim F_L0 As Double                           ' Valeur de la fonction F(L0)
' Dim F_L0prime As Double                      ' Valeur de la derivee de la fonction F(L0)
' Dim L1 As Double                             ' Valeur de L_1 Calculée

'========================== AFFECTATION DE VALEURS A CHAQUE VARIABLE ======================
Set L0 = Sheets("Feuil1").Range("B1")
Set F_L0 = Sheets("Feuil1").Range("B2")
Set F_L0prime = Sheets("Feuil1").Range("B3")
Set Epsilon = Sheets("Feuil1").Range("B4")
Set tolerance = Sheets("Feuil1").Range("B5")
Set L1 = Sheets("Feuil1").Range("B6")

'Sheets("PAS_SEISME_2").Cells(41, 4).Range("D41")

    Do
 
    L1 = L0 - F_L0 / F_L0prime
    L0 = L1
    Loop While (Abs(L1 - L0) < Epsilon)
 

End Sub

epsilon n'est pas un entier ("integer")

 

[Dranreb]

Bonsoir.
Vos fonction sont évaluées par des formules dans des cellules, or vous ne faite pas dialoguer vos variables avec ces cellules pour qu'elles vous les recalcule à chaque passage dans la boucle.

Remarque: vous pourriez utiliser la méthode GoalSeek pour dégrossir.

Quelque bouts de code extraits d'un outil personnel :

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