Problème solveur

Bonjour,

Je souhaiterais ici créer un code qui permettrait d'adapter les plages de saisie en fonction du nombre d'arguments présents en colonne A. Ici, le solveur prends en compte la range A23:A32 alors que ça fausse le calcul.

Mes démarches :

Dim lr As Long

lr = Range("$B$18").End(xlDown).Row

SolverReset

SolverOk SetCell:="$C$34", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$18:$B$" & lr, _

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

SolverAdd CellRef:="$B$18:$B$" & lr, Relation:=6, FormulaText:="TousDifférents"

SolverAdd CellRef:="$B$18:$B$" & lr, Relation:=4, FormulaText:="entier"

SolverOk SetCell:="$C$34", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$18:$B$" & lr, _

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

SolverOk SetCell:="$C$34", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$18:$B$" & lr, _

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

SolverSolve

Bonjour,

Une proposition de macro :

Sub OptimiserTrajet()

Dim NbEtapes As Integer, i As Integer

With Sheets("Distancier")
    NbEtapes = .Cells(1, .Columns.Count).End(xlToLeft).Column - 1 'Détermine le nombre de ville sur la base de la ligne 1
    .Range("B17") = 0 'Ville départ imposée (1ère ville du distancier)
    .Range("B" & 17 + NbEtapes) = 0 'Ville retour imposée (= ville de départ)
    'Evite le calcul d'étapes inutiles
    For i = 1 To 15 - NbEtapes
        .Range("B" & 17 + NbEtapes + i) = "x"
    Next i
    'Paramétrer le Solveur
    SolverReset 'Supprime les anciens scénarii
    SolverOk SetCell:="$C$34", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$18:$B$" & 16 + NbEtapes, Engine:=3, EngineDesc:="Evolutionary" 'Cellule objectif, plage variable et moteur de résolution
    SolverAdd CellRef:="$B$18:$B$" & 16 + NbEtapes, Relation:=6, FormulaText:="TousDifférents" 'Contrainte 1 : pas de doublons
    SolverAdd CellRef:="$B$18:$B$" & 16 + NbEtapes, Relation:=4, FormulaText:="entier" 'Contrainte 2 : nombres entiers
    SolverOptions PopulationSize:=100, MutationRate:=0.1 'Paramètres du moteur de résolution (vitesse +)
    SolverSolve Userfinish:=True 'Lancer résolution
End With

End Sub

PS : il faut que le Solveur soit activé dans les préférences VBA, et la macro n'est valide que pour un fichier de même structure que le dernier fournit et ne présentant aucune information autre que les villes en ligne 1.

https://forum.excel-pratique.com/viewtopic.php?f=2&t=13

Sébastien a écrit :

8. En postant une question, vous vous engagez à donner suite à votre demande. C'est vraiment le minimum de respect pour les membres qui prennent le temps de vous aider, si vous ne voulez pas respecter les personnes à qui vous demandez de l'aide, ne posez pas de question, merci.

Bonjour,

Autant pour moi, le code m'a bien servi je le valide desuite ^^

YoniK a écrit :

Bonjour,

Autant pour moi, le code m'a bien servi je le valide desuite ^^

Merci du retour et bonne continuation !