Valeur cible sans saisie manuelle

  • Initiateur de la discussion Initiateur de la discussion _Flo_
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

_Flo_

XLDnaute Nouveau
Bonjour à tous,


je cherche un moyen d'automatiser l'outil valeur cible d'excel sans avoir à saisir manuellement

la "valeur à atteindre" mais en faisant référence à une cellule de mon tableau

pour ensuite l'appliquer automatiquement sur 100 à 200 lignes.

j'ai trouver un post à ce sujet sur le forum:

https://www.excel-downloads.com/threads/systematiser-la-fonction-valeur-cible.20607/

mais impossible de trouver le post cité par André qui aurait la solution à mon problème ....


Par avance, merci.

PS: je suis débutant sur excel et je ne connais absolument rien à tout ce qui touche à la programmation, vba...
 
Re : Valeur cible sans saisie manuelle

Bonjour _Flo_
Bienvenue à toi, 🙂

Je viens de faire un petit test rapide: l'enregistreur de macro crée un code pas trop compliqué et qui permet de faire référence à une cellule, plutôt qu'encoder une valeur.
Si tu as besoin d'un coup de main, dépose un petit fichier simplifié, sans données confidentielles!
 
Re : Valeur cible sans saisie manuelle

Merci à vous 2 de répondre aussi rapidement,

pour plus de clarté voici un fichier qui présente bien ce que je recherche,

car je n'arrive pas à appliquer l'exemple VBA précédent à mon cas de figure

et d'ailleurs je ne sais même pas comment exporter un VBA d'un fichier à un autre 😕

quand je dis que je suis débutant je vous mens vraiment pas ...
 

Pièces jointes

Re : Valeur cible sans saisie manuelle

Pour le petit écart j'ai ça chez moi:
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
ApprocherMieux RgCbl, VCible, RgVar, 0.001
ApprocherMieux RgCbl, VCible, RgVar, -0.00001
ApprocherMieux RgCbl, VCible, RgVar, 0.0000001
ApprocherMieux RgCbl, VCible, RgVar, -0.000000001
PrécAt = RgCbl.Value - VCible
If PrécAt = 0 Then
   Z = " sans erreur décelable"
Else
   Z = Format(PrécAt, "0.0E+00"): If Left$(Z, 1) <> "-" Then Z = "+" & Z
   Z = " avec une erreur de " & Z
   End If
UfSelect.ÉtapePlage 2, AutreMsg:="Cette cellule vient d'être réglée pour que " & DescrZones(RgCbl) & "" _
   & vbLf & "atteigne " & VCible & Z & "."
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
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
 
Dernière édition:
Re : Valeur cible sans saisie manuelle

Dans le cas présent, c'est simple :

Si les colonnes sont les mêmes, un simple copier-coller du code.
- tu ouvres les deux fichiers
- tu fais Alt+F11 pour aller dans le VBE (c'est là qu'est le code)
- dans la colonne de gauche, tu repère ton fichier qui comporte le code et tu cliques sur feuil1
- dans la partie droite, tu vois le code (dans le cas présent c'est juste quelques lignes)
- tu sélectionnes
- tu repère le fichier à compléter et tu cliques sur feuil1
- dans la partie droite, tu colles le code

- tu retournes dans ta feuille et tu crée un bouton (activeX) , tu fais un clic droit dessus puis Propriétés et en haut du tableau tu le nommes ValeurCible (c'est le titre du sous-programme que tu as copié)
- tu sors du mode création (une équerre bleue dans la barre d'outil)

Tu peux aussi commencer par créer le bouton, le nommer et double-cliquer dessus avant de sortir du mode création ; tu te retrouves dans le VBE et EXCEL t'a préparé la première et la dernière ligne du sous-programme ; il te reste à aller copier les autres pour les coller entre elles deux

Nota : le module 1 n'a pas à être recopié ; j'ai juste oublié de l'effacer...

Cordialement
 
Re : Valeur cible sans saisie manuelle

Bonsoir à tous


Un bricolage simpliste sans "solveur", mais peut-être suffisant dans le cas qui nous occupe :
VB:
Private Sub Worksheet_BeforeRightClick(ByVal Cible As Range, Cancel As Boolean)
Dim d#, n%, plg As Range, oCel As Range
    Set plg = Intersect(Cible, Range("M17:M44")) 'plage à adapter
    If Not plg Is Nothing Then
        Cancel = True
        For Each oCel In plg.Cells
            n = 0
            d = 1
            oCel.Value = 0
            On Error Resume Next
            Do While d > 0.000000001 And 100 > n
                Do While oCel.Offset(0, -10).Value > oCel.Offset(0, 5).Value
                    If n > 100 Then Exit Do
                    n = n + 1
                    oCel.Value = oCel.Value + d
                Loop
                oCel.Value = oCel.Value - d
                d = d / 10
            Loop
            On Error GoTo 0
        Next
    End If
End Sub


ROGER2327
#5653


Mercredi 25 Pédale 139 (Saint Peligraf Poligrafovitch, chien - fête Suprême Quarte)
29 Ventôse An CCXX, 9,9619h - frêne
2012-W12-1T23:54:30Z
 

Pièces jointes

Dernière édition:
Re : Valeur cible sans saisie manuelle

Bien l'bonjour,

ce dernier code fonctionne également très bien et est facile d'utilisation.
Par contre j'ai toujours des ptits soucis pour l'utiliser dans un autre fichier
où le calcul reste le même mais les cellules sont différentes...
J'ai tout de même changer la "plage à adapter" mais pour savoir où sont les cellules qui entrent en jeu dans ce code ....
j'vous avoue que pour moi c'est du chinois...
 
Re : Valeur cible sans saisie manuelle

Bonjour _Flo_, bonjour à tous


Bien l'bonjour,

ce dernier code fonctionne également très bien et est facile d'utilisation.
Par contre j'ai toujours des ptits soucis pour l'utiliser dans un autre fichier
où le calcul reste le même mais les cellules sont différentes...
J'ai tout de même changer la "plage à adapter" mais pour savoir où sont les cellules qui entrent en jeu dans ce code ....
j'vous avoue que pour moi c'est du chinois...
La procédure est déclenchée si un clic-droit survient dans la plage "M17:M44". Elle est alors exécutée successivement sur toutes les cellules sélectionnées dans cette plage. Pour faire cela, on a besoin de comparer des valeurs dans les colonnes C et R. Or, on ne voit de mention explicite à ces colonnes nulle part. En fait, la référence à ces colonnes est faite de manière relative dans la ligne de code
VB:
Do While oCel.Offset(0, -10).Value > oCel.Offset(0, 5).Value
Dans cette ligne, oCel désigne la cellule en cours de calcul. oCel.Offset(0, -10) désigne la cellule située 10 colonnes à gauche de la cellule oCel. Ce qui fait que oCel étant en colonne M, oCel.Offset(0, -10) est en colonne A (sur la même ligne).
De même, oCel.Offset(0, 5) désigne la cellule située 5 colonnes à droite de la cellule oCel. Ce qui fait que oCel étant en colonne M, oCel.Offset(0, 5) est en colonne R.

C'est donc cette ligne de code qu'il convient de modifier pour adapter la procédure si les colonnes de références sont autres que les colonnes C et R.

Exemple : supposons qu'au lieu de calculer les cellules de la plage"M17:M44" en faisant références aux colonnes C et R, vous voulez faire le calcul sur la colonne "K20:K90" en faisant références aux colonnes V et G. Vous devez :


  1. Remplacer
    VB:
    Set plg = Intersect(Cible, Range("M17:M44"))
    par
    VB:
    Set plg = Intersect(Cible, Range("K20:K90"))
  2. Remplacer
    VB:
    Do While oCel.Offset(0, -10).Value > oCel.Offset(0, 5).Value
    par
    VB:
    Do While oCel.Offset(0, 11).Value > oCel.Offset(0, -4).Value
    parce que la colonne V est située 11 colonnes à droite de la colonne K et la colonne G est située 4 colonnes à gauche de la colonne K.


J'espère avoir compris votre demande. Si tel n'est pas le cas, dites-le moi...


Bon courage.


ROGER2327
#5656


Jeudi 26 Pédale 139 (Saint Pâle, mineur - fête Suprême Quarte)
30 Ventôse An CCXX, 4,0510h - plantoir
2012-W12-2T09:43:20Z
 
Re : Valeur cible sans saisie manuelle

Quel sens de la pédagogie!

Je crois qu'on ne peut pas mieux faire,

les explications sont claires, concises et illustrées par des exemples ...

Encore merci pour ce code et pour les premiers cours de chinois ... 😉
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
6
Affichages
528
Retour