Solver contraintes

hey tout le monde : !

je voudrais savoir comment entrer dans le solver des contraintes qui peuvent changer selon le choix de l'utilisateur? en fait je gère un portefeuille et jaimerais que ce soit l'utilisateur qui entre les actifs quil veut et ensuite dans le choix d'optimisation ( c la qu'entre le solver ) l'utilisateur peut rentrer les contraintes qu'il veut.. mais je ne sais pas trop le coder... sachant que le userform lui demande sur quel actif i veut rentrer les contraintes et elles s'affichent ensuite sur excel et c de là que je pars pour le solver....voici mon code et mon dossier ( je pense que ce sera plus clair...).. avez vous des idées?

voici mon code:

SolverReset

SolverOk SetCell:="$H$5", MaxMinVal:=2, ValueOf:=0, ByChange:="$D$3:$D$" & c - 1 + 3 & ""

SolverAdd CellRef:="$D$24", Relation:=2, FormulaText:="1"

For i = 15 To 17

If Range("G15") <> "" Then

If Worksheets("Optimization").Cells(i, 8).Text = " <= " Then

marqueur_bis = Application.Match(Worksheets("Optimization").Cells(i, 7), Worksheets("Optimization").Range("B3:B23"), 0)

SolverAdd CellRef:=Range("A" & marqueur_bis & "").Offset(0, -2), Relation:=Val("$H$" & i & ""), FormulaText:="1"

Else

If Worksheets("Optimization").Cells(i, 8).Text = " = " Then

marqueur_bis = Application.Match(Worksheets("Optimization").Cells(i, 7), Worksheets("Optimization").Range("B3:B23"), 0)

SolverAdd CellRef:=Range("A" & marqueur_bis & "").Offset(0, -2), Relation:=Val("$H$" & i & ""), FormulaText:="2"

Else

If Worksheets("Optimization").Cells(i, 8).Text = " >= " Then

marqueur_bis = Application.Match(Worksheets("Optimization").Cells(i, 7), Worksheets("Optimization").Range("B3:B23"), 0)

SolverAdd CellRef:=Range("A" & marqueur_bis & "").Offset(0, -2), Relation:=Val("$H$" & i & ""), FormulaText:="3"

End If

End If

End If

End If

Next i

dossier :

merciiiiiiiiiiiiiii

Sab

Bonjour,

Déjà des conseils sur le solveur qui permettent de le découvrir un peu plus si tu n'es pas familière :

http://www.emse.fr/~beaune/solveur/welcome.html

Ensuite un bon exemple assez complet et détaillé en vba, avec une partie sur les contraintes :

http://support.microsoft.com/kb/843304

et la doc des fonctions vba de l'éditeur :

http://www.solver.com/content/basic-solver-vba-functions

1) merci d'utiliser la balise Code (bouton au-dessus) et de l'indenter, là c'est imbuvable.

2) soit plus concise et précise dans ta question. Par exemple :

dans module1 proc toto :

SolverAdd CellRef:="$D$24", Relation:=2, FormulaText:="1"

je veux faire varier "$D$24" de ça à ça et ....

En mettant une expression correcte. Pas une que tu as commencé à bricoler qui n'a plus aucun sens pour nous.

On risque de mal interpréter, perte de temps pour tout le monde...

eric

Bonjour et merci eriic de nouveau pour ton aide.

Je sais bien que c du bricolage mon code ahah mais je suis obligé car les actifs sur lesquels les contraintes sont choisis varient, de meme pour les relations, donc je peux pas etre précise comme tu me la demandé car c'est l'utilisateur qui va choisir ses contraintes...

mon offset vient du fait que lorsque l'utilisateur va choisir ses contraintes sur excel va s'afficher le nom de l'actif puis à coté sil a choisi >= ou= ou >= et ensuite le chiffre.... donc je lui dit (sachant que dans la colonne 2 il y a le nom des actifs et deux case plus loin il y a les premières pondérations choisit par l'utilisateur, donc je lui dit tu vas chercher le nom de l'actif où il est dans la colonne deux et tu te décales de deux case ( case des pondérations) ... C'est plus clair?

Sab

Tu aimes perdre du temps toi...

je crois quon est dans un langage de sourd, je vais chercher de mon coté merci pour ton aide eriic quand meme

Sab

Bonjour,

Oui, c'est mieux ainsi.

Pas envie de perdre 1h à essayer de deviner ce que tu veux parmi un truc illisible et d'y passer encore 2 jours.

C'est au demandeur de faire des efforts de clarté et de précision s'il veut être aidé.

D'autant plus que tu postes sur plusieurs forums sans le signaler ce qui fait que certains cherchent pour rien, et d'autre part ne bénéficient pas des compléments tu peux apporter à droite et à gauche.

Attend le suivant qui sera plus courageux.

eric

ce n'etait pas du tout un message de colère que j'ai laissé précédemment, c'est juste que j'ai voulu chercher par moi même vu que ça paraissait compliqué par écrit voila tout. Je ne remets en question rien te concernant.

Merci de ton aide en tout cas

Sab

Bonjour,

Je ne trouve pas mon bonheur dans la réponse précédente, mais je pense que je cherche à faire la même chose,

J'ai le tableau ci dessous que je souhaite actualiser automatiquement par une boucle VBA :

DD DE DF DG DH DI DK

6-L_Ligne_T 2200 3250 4150 4300 0 L_Ligne_R

7-13596 (1) (1) (2) 13750

8-16500

9-14800

16-

J'en suis arrivé au code ci-dessous qui ne fonctionne pas

(je suis débutant en macro, mais le problème vient de la boucle)

Si vous avez un petit conseil

Merci par avance !!

Sub Solveur_Vba()

'

' Solveur_Vba Macro

'

Range("DE7:DI16").ClearContents

Application.DisplayAlerts = False

For sLigne = 1 To 8

SolverOk SetCell:="$DJ$7", MaxMinVal:=2, ValueOf:=0, ByChange:="$DE$7:$DI$7", _

Engine:=1, EngineDesc:="GRG Nonlinear"

SolverAdd CellRef:="$DJ$7", Relation:=3, FormulaText:="$DD$7"

SolverAdd CellRef:="$DE$7:$DI$7", Relation:=4, FormulaText:="entier"

SolverOk SetCell:="$DJ$7", MaxMinVal:=2, ValueOf:=0, ByChange:="$DE$7:$DI$7", _

Engine:=2, EngineDesc:="Simplex LP"

SolverOk SetCell:="$DJ$7", MaxMinVal:=2, ValueOf:=0, ByChange:="$DE$7:$DI$7", _

Engine:=2, EngineDesc:="Simplex LP"

SolverSolve Userfinish = True

Next J

Application.DisplayAlerts = True

End Sub

Bonjour,

1er conseil : utiliser l'icone </> quand tu colles un code, qu'il reste lisible et indenté.

2nd conseil : on ne peut pas reconstituer ton tableau, il faut joindre un xls

    For sLigne = 1 To 8
       ....
    Next J

Tes variables de début et de fin ne sont pas identiques, ce n'est pas bon.

Par ailleurs tu ne te sers ni de l'une, ni de l'autre dans la boucle.

Précise ce que tu veux faire varier dedans si tu veux plus d'aide.

eric

Merci pour ton retour

Je viens de faire quelques modifications sans succès :

Sub Solveur_VBA()
 Dim K As Integer
  For K = 7 To 16
' Solveur_VBA2 Macro
    SolverOk SetCell:="$DJ" & K, MaxMinVal:=2, ValueOf:=0, ByChange:= _
        "$DE,$DF,$DG,$DH,$DI" & K, Engine:=2, EngineDesc:="Simplex LP"
    SolverAdd CellRef:="$DE" & K, Relation:=4, FormulaText:="entier"
    SolverOk SetCell:="$DJ" & K, MaxMinVal:=2, ValueOf:=0, ByChange:= _
        "$DE,$DF,$DG,$DH,$DI" & K, Engine:=2, EngineDesc:="Simplex LP"
    SolverDelete CellRef:="$DE" & K, Relation:=4
    SolverOk SetCell:="$DJ" & K, MaxMinVal:=2, ValueOf:=0, ByChange:= _
        "$DE,$DF,$DG,$DH,$DI" & K, Engine:=2, EngineDesc:="Simplex LP"
    SolverOk SetCell:="$DJ" & K, MaxMinVal:=2, ValueOf:=0, ByChange:= _
        "$DE,$DF,$DG,$DH,$DI" & K, Engine:=2, EngineDesc:="Simplex LP"
    SolverSolve Userfinish:=True
 Next
End Sub

A partir d'un bouton je souhaites compléter les colonnes DE à DI (variables_ nombre entier)

En ayant la longueur calculée la plus faible en DJ

En colonne DD j'ai la longueur min.

Merci de ton aide

capture12
"$DE,$DF,$DG,$DH,$DI" & K

ça ne te fait qu'un seul range de correct, le dernier.

Essaie avec :

    SolverOk SetCell:="$DJ" & K, MaxMinVal:=2, ValueOf:=0, ByChange:= _
        [DE1:DI1].Offset(K - 1), Engine:=2, EngineDesc:="Simplex LP"

mais les autres lignes sont à faire aussi.

eric

Merci pour ta réponse, mais il semble y avoir un autre bug

Sub Solveur_VBA()
 Dim K As Integer
  For K = 7 To 16
' Solveur_VBA2 Macro
    SolverOk SetCell:="DJ" & K, MaxMinVal:=2, ValueOf:=0, ByChange:= _
        [DE1:DI1].Offset(K - 1), Engine:=2, EngineDesc:="Simplex LP"
    SolverDelete CellRef:=[DE1:DI1].Offset(K - 1), Relation:=4
    SolverOk SetCell:="DJ" & K, MaxMinVal:=2, ValueOf:=0, ByChange:= _
        [DE1:DI1].Offset(K - 1), Engine:=2, EngineDesc:="Simplex LP"
    SolverOk SetCell:="DJ" & K, MaxMinVal:=2, ValueOf:=0, ByChange:= _
        [DE1:DI1].Offset(K - 1), Engine:=2, EngineDesc:="Simplex LP"
    SolverDelete CellRef:="DJ" & K, Relation:=3, FormulaText:="DD" & K
    SolverOk SetCell:="DJ" & K, MaxMinVal:=2, ValueOf:=0, ByChange:= _
        [DE1:DI1].Offset(K - 1), Engine:=2, EngineDesc:="Simplex LP"
    SolverAdd CellRef:="DJ" & K, Relation:=3, FormulaText:="DD" & K
    SolverAdd CellRef:="DE" & K, Relation:=4, FormulaText:="entier"
    SolverAdd CellRef:="DF" & K, Relation:=4, FormulaText:="entier"
    SolverAdd CellRef:="DG" & K, Relation:=4, FormulaText:="entier"
    SolverAdd CellRef:="DH" & K, Relation:=4, FormulaText:="entier"
    SolverAdd CellRef:="DI" & K, Relation:=4, FormulaText:="entier"
    SolverOk SetCell:="DJ" & K, MaxMinVal:=2, ValueOf:=0, ByChange:= _
        [DE1:DI1].Offset(K - 1), Engine:=2, EngineDesc:="Simplex LP"
    SolverOk SetCell:="DJ" & K, MaxMinVal:=2, ValueOf:=0, ByChange:= _
        [DE1:DI1].Offset(K - 1), Engine:=2, EngineDesc:="Simplex LP"
 Next K
End Sub

un bug ne veux rien dire...

Résultat incorrect ? Ligne en erreur ? Message d'erreur ?

Sans doute qu'avec le fichier déjà demandé au lieu d'une photo d'écran ça aiderait.

eric

Non je n'ai aucun message d'erreur, les calculs semblent se lancer, toutefois aucun résultat n'est actualisé.

Ci-joint le fichier

1classeur1.xlsm (15.53 Ko)

Merci

Je ne comprend pas bien...

Pourquoi DE:DJ dans ta macro alors que sur ta feuille tu es en B:G ???

Fait d'abord fonctionner le solveur en manuel, après seulement tu t'occupes de le faire en vba.

Ton modèle de donnée doit ressembler à ça :

2020 03 30 19 21 27

eric

Oui l'autre navré le fichier d'origine étant trop lourd j'ai refait un exemple de la problématique.

Le code sans boucle est le suivant :

Sub Macro1()
' Macro1 Macro
    SolverOk SetCell:="$G$2", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$2:$F$2", _
        Engine:=2, EngineDesc:="Simplex LP"
    SolverAdd CellRef:="$B$2:$F$2", Relation:=4, FormulaText:="entier"
    SolverAdd CellRef:="$G$2", Relation:=3, FormulaText:="$A$2"
    SolverOk SetCell:="$G$2", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$2:$F$2", _
        Engine:=2, EngineDesc:="Simplex LP"
    SolverOk SetCell:="$G$2", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$2:$F$2", _
        Engine:=2, EngineDesc:="Simplex LP"
    SolverSolve
End Sub
1classeur1.xlsm (17.14 Ko)

Maintenant je cherche à faire la boucle de la ligne 2 à 11.

Bien à vous,

Ok, je suis d'accord.

Sauf que tu répètes une ligne, il faut être attentif.

Tu n'as plus qu'à mettre ta boucle et faire varier tes $2 selon celle-ci. Comme je t'ai montré ou selon ton inspiration. Il y a de multiples façons pour le faire.

Par contre tes contraintes vont s'ajouter...

Il faut faire un reset du solveur en début de boucle : SolverReset

Et pour fignoler, inutile de le faire travailler si A est vide. Teste Ax <> "" pour exécuter tes instructions.

eric

Merci Eric, cela fonctionne bien =)

Sub Macro1()
' Macro1 Macro
Dim K As Integer
For K = 2 To 11
    SolverReset
    SolverOk SetCell:="G2" & K, MaxMinVal:=2, ValueOf:=0, ByChange:=[B1:F1].Offset(K - 1), _
        Engine:=2, EngineDesc:="Simplex LP"
    SolverAdd CellRef:=[B1:F1].Offset(K - 1), Relation:=4, FormulaText:="entier"
    SolverAdd CellRef:="G" & K, Relation:=3, FormulaText:="A" & K
    SolverOk SetCell:="G" & K, MaxMinVal:=2, ValueOf:=0, ByChange:=[B1:F1].Offset(K - 1), _
        Engine:=2, EngineDesc:="Simplex LP"
    SolverSolve Userfinish:=True
    Next
End Sub

Good

mais cette fois c'est SolverOk que tu as doublé pour rien... Il faut te relire attentivement.

eric

Edit : d'ailleurs le 1er est faux à cause de "G2" & K

Si K=1 => G21

Rechercher des sujets similaires à "solver contraintes"