Quel est l'ALGORITHME derrière la fonction VALEUR CIBLE (Goal seek goal) ?

MisterT

XLDnaute Occasionnel
Bonjour :)

J'aurais besoin de connaître l’Algorithme derrière la fonction "Valeur Cible" ou une Macro détaillée qui ferait la même chose que cette fonction car j'ai besoin de convertir la Macro suivante Excel pour une utilisation dans un autre programme:
Code:
Sub Macro_Tension_globale()
     Sheets("Feuille Calcul").Range("E30").GoalSeek Goal:=Range("N4"), ChangingCell:=Range("O4")
End Sub

Est-ce qu'il y a quelqu'un qui accepterait d'utiliser un peu de son temps et de ses connaissances pour résoudre cette question ?

Merci :)
MisterT
 

Dranreb

XLDnaute Barbatruc
Re : Quel est l'ALGORITHME derrière la fonction VALEUR CIBLE (Goal seek goal) ?

Bonjour.
Pour une fonction monotone :
Il y a la recherche dichotomique qui peut cibler l'argument même d'une fonction n'offrant que des valeurs discrètes.
Pour une fonction continue on peut chercher à quel x' la droite de même pente que la dérivée à la valeur x d'essai atteint la valeur y souhaitée. Si la fonction n'a pas de pentes presque nulles à certains endroits éloignés du point cherché c'est ce qui converge en général le plus vite.
Je me suis refait mon dialogue valeur cible à mon goût. J'y fait suivre l'estimation du GoalSeek par :
VB:
ApprocherMieux RgCbl, VCible, RgVar, 0.001
ApprocherMieux RgCbl, VCible, RgVar, -0.00001
ApprocherMieux RgCbl, VCible, RgVar, 0.0000001
ApprocherMieux RgCbl, VCible, RgVar, -0.000000001
Avec :
VB:
Sub ApprocherMieux(RgCible As Range, VCible As Double, RgModif As Range, Ajout As Double)
Dim X1 As Double, Y1 As Double, X2 As Double, Y2 As Double
X1 = RgModif.Value: On Error GoTo Resto: Y1 = RgCible.Value
X2 = X1 + Ajout: RgModif.Value = X2: Y2 = RgCible.Value
If Y2 <> Y1 Then
   RgModif.Value = X1 + (X2 - X1) * (VCible - Y1) / (Y2 - Y1)
   If Abs(RgCible.Value - VCible) < Abs(Y1 - VCible) Then Exit Sub
   End If
Resto: RgModif.Value = X1
End Sub
En espérant que ça puisse vous inspirer…
 
Dernière édition:

MisterT

XLDnaute Occasionnel
Re : Quel est l'ALGORITHME derrière la fonction VALEUR CIBLE (Goal seek goal) ?

Bonjour Dranreb :)

Merci beaucoup pour ton temps et expertise pour me fournir une solution très avancée !!! Celle-ci dépasse largement mes compétences de compréhension mais j'y fais un effort.

Si je comprends bien quelques points, car je suis un peu confus par la complexité (à mes yeux) de la solution, la cellule à définir serait VCible, la valeur à atteindre serait RgCible et la valeur à modifier serait RgModif

Serait-il possible pour toi d'écrire le code (ton code détaillé) qui remplacerait directement le code que j'ai fourni (Goal Seek) en utilisant les mêmes cellules que dans mon code et qui mènerait au même résultat que le Goal Seek et si possible, y ajouter une petite note au côté des lignes principales ?
Code:
Sub Macro_Tension_globale()
     Sheets("Feuille Calcul").Range("E30").GoalSeek Goal:=Range("N4"), ChangingCell:=Range("O4")
End Sub

Merci beaucoup encore, c'est gentil !!!
MisterT
 

Dranreb

XLDnaute Barbatruc
Re : Quel est l'ALGORITHME derrière la fonction VALEUR CIBLE (Goal seek goal) ?

Non. VCible est la valeur à atteindre
RgCible est la cellule contenant la formule susceptible de la rendre
et RgModif la cellule à modifier sur laquelle cette formule s'appuie.

Il y a ces instructions devant les ApprocherMieux :
VB:
XSvg = RgVar.Value: If RgVar.HasFormula Then RgVar.Value = XSvg
If Not RgCbl.GoalSeek(Goal:=VCible, ChangingCell:=RgVar) Then
   Rép = MsgBox("GoalSeek impuissant." & vbLf & "Voulez vous restaurer " & DescrZones(RgVar) & " à " & XSvg & " ?", _
      vbYesNoCancel + vbQuestion, "Valeur cible")
   If Rép = vbYes Then RgVar.Value = XSvg: UfSelect.ÉtapePlage 2, AutreMsg:="La cellule " & DescrZones(RgCbl) _
      & " n'a pu atteindre " & VCible & vbLf & "par aucune modification de cette cellule."
   If Rép <> vbNo Then Exit Sub
   End If
Donc sauf erreur de ma part ce serait plutôt:
VB:
ApprocherMieux Sheets("Feuille Calcul").Range("E30"), Range("N4").Value, Range("O4"), 0.001
 

MisterT

XLDnaute Occasionnel
Re : Quel est l'ALGORITHME derrière la fonction VALEUR CIBLE (Goal seek goal) ?

Merci Dranreb ! :)

J'ai fait le code ici-bas et ça bloque à DescrZones:
Code:
Sub Macro_tension_globale()
Dim RgCbl As Range, VCible As Double, RgVar As Range
RgCbl = Range("E30")
VCible = Range("N4")
RgVar = Range("O4")

XSvg = RgVar.Value: If RgVar.HasFormula Then RgVar.Value = XSvg
If Not RgCbl.GoalSeek(Goal:=VCible, ChangingCell:=RgVar) Then
   Rép = MsgBox("GoalSeek impuissant." & vbLf & "Voulez vous restaurer " & DescrZones(RgVar) & " à " & XSvg & " ?", _
      vbYesNoCancel + vbQuestion, "Valeur cible")
   If Rép = vbYes Then RgVar.Value = XSvg: UfSelect.ÉtapePlage 2, AutreMsg:="La cellule " & DescrZones(RgCbl) _
      & " n'a pu atteindre " & VCible & vbLf & "par aucune modification de cette cellule."
   If Rép <> vbNo Then Exit Sub
   End If
   
ApprocherMieux RgCbl, VCible, RgVar, 0.001
ApprocherMieux RgCbl, VCible, RgVar, -0.00001
ApprocherMieux RgCbl, VCible, RgVar, 0.0000001
ApprocherMieux RgCbl, VCible, RgVar, -0.000000001
End Sub
-----------------------------------------------------------
Sub ApprocherMieux(RgCible As Range, VCible As Double, RgModif As Range, Ajout As Double)
Dim X1 As Double, Y1 As Double, X2 As Double, Y2 As Double
RgCible = Range("E30")
VCible = Range("N4")
RgModif = Range("O4")
X1 = RgModif.Value: On Error GoTo Resto: Y1 = RgCible.Value
X2 = X1 + Ajout: RgModif.Value = X2: Y2 = RgCible.Value
If Y2 <> Y1 Then
   RgModif.Value = X1 + (X2 - X1) * (VCible - Y1) / (Y2 - Y1)
   If Abs(RgCible.Value - VCible) < Abs(Y1 - VCible) Then Exit Sub
   End If
Resto: RgModif.Value = X1
End Sub
Ce que j'ai fait est-il bon et pourquoi il bloque à DescrZones ?

Merci,
MisterT :)
 

Dranreb

XLDnaute Barbatruc
Re : Quel est l'ALGORITHME derrière la fonction VALEUR CIBLE (Goal seek goal) ?

Bonjour.
Parce que c'est une fonction perso de mon classeur de macros. Vous pouvez le remplacer par RgVar.Address ou simplifier tout ça si c'est pour calculer toujours la même chose.
Le début n'est pas bon. Mettre:
VB:
Set RgCbl = ActiveSheet.Range("E30")
VCible = ActiveSheet.Range("N4").Value
Set RgVar = ActiveSheet.Range("O4")
J'ai précisé ActiveSheet devant simplement parce que je déteste la méthode Range de l'objet global (elle plante trop souvent à mon gout), je n'utilise que la méthode Range de l'objet WorkSheet. Mais je n'y mets en général pas ActiveSheet mais le nom VBA de l'objet WorkSheet tel qu'il figure dans la rubrique "Microsoft Excel Objets" à gauche de son nom Excel rappelé entre parenthèse. Il n'y a pas à les redéclarer dans la sub ApprocherMieux. Ne voyez vous pas qu'ils sont passés en paramètres ?
 

MisterT

XLDnaute Occasionnel
Re : Quel est l'ALGORITHME derrière la fonction VALEUR CIBLE (Goal seek goal) ?

Allô Dranreb :)

Merci infiniment pour ta solution, c'est vraiment GÉNIAL !!!

Puisque c'est toujours pour calculer la même chose, j'ai simplifié le tout comme suggéré..

J'ai aussi corrigé le début comme suggéré:
Code:
Set RgCbl = ActiveSheet.Range("E30")
VCible = ActiveSheet.Range("N4").Value
Set RgVar = ActiveSheet.Range("O4")

En redéclarant au début, je n'avais pas remarqué qu'ils étaient passés en paramètres car j'ignore même ce que signifie passés en paramètres, pardonne-moi mon ignorance à ce sujet...

Un gros MERCI, j'apprécie grandement ton expertise et le temps que tu as pris pour m'aider !!!

MisterT :):):)