Solver in VBA
Hendrik
Als relativer VBA Neuling habe ich folgendes Problem:
In dem unten aufgeführten Quelltext frage ich im Rahmen einer Schleife den Solver ab.
Hier habe ich drei Nebenbedingungen eingerichtet, nach denen Optimiert werden soll. Einer der drei wird jedoch einfacvh ignoriert. Es handelt sich dabei um
SolverAdd CellRef:=Cells(26, iColZiel + 2), Relation:=2, FormulaText:=Cells(26, iColZiel)
Wenn ich men Bendingunen nach Durchlauf anschaue, wird stets die Bedingung = 0 gesetzt und nicht wie gewüncht enstprechend dem Zielwert.
Da es sich um ein Minimierungsproblem erledigt der Solver nun logischerweise diese Minimierung durch NUllsetzung und "ignoriert" die anderen beiden Bedingungen
Wäre genial, wenn sich jemand mal den entsprechenden Teilcode angucken könnte:
'Solvereinsatz
SolverOk SetCell:=Cells(26, iColZiel + 3), MaxMinVal:=2, ValueOf:="0", ByChange:=Range(Cells(2, iColZiel + 2), Cells(25, iColZiel + 2))
SolverAdd CellRef:=Range(Cells(2, iColZiel + 2), Cells(25, iColZiel + 2)), Relation:=3, FormulaText:="0"
SolverAdd CellRef:=Range(Cells(2, iColZiel + 2), Cells(25, iColZiel + 2)), Relation:=1, FormulaText:="360"
SolverAdd CellRef:=Cells(26, iColZiel + 2), Relation:=2, FormulaText:=Cells(26, iColZiel)
SolverOk SetCell:=Cells(26, iColZiel + 3), MaxMinVal:=2, ValueOf:="0", ByChange:="Range(Cells(2, iColZiel + 2), Cells(25, iColZiel + 2))"
SolverSolve UserFinish:=True
SolverReset
Den gesamten Code findet ihr hier, bin für alle Verbersserungsvorschläge offen!!!
Vielen Dank schon mal und genießt das Wetter :D
Hendrik
Sub PrognoseSort()
Dim iRow As Long
Dim iCol As Long
Dim iColZiel As Long
Dim lngZeile As Long
lngCol = 1
iRow = 1
iColQuelle = 2
iColZiel = 2
' Import der gesamten Tageslast aus Lastgang_opt.xlsm
Workbooks.Open Filename:= _
"Z:\LastgangOpt\Lastgang_Optimiert.xlsm"
Application.Run "Lastgang_Optimiert.xlsm!Tageslast_berechnen"
Range("E3:F366").Select
Range(Selection, Selection.End(xlDown)).Copy
Windows("Prognose vom 01.02.2011.xlsm").Activate
Range("A30").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Transponierung/Sortierung der Preisprognosen auf Tabellenblatt1
Do While Cells(iRow, iColQuelle).Value ".."
For i = 1 To 25
Sheets("Prognose vom 01.02.2011").Cells(i, iColQuelle).Copy
Sheets("Tabelle1").Cells(i, iColZiel).PasteSpecial
Sheets("Tabelle1").Cells(i + 1, iColZiel + 1).Value = i
Cells(i + 1, iColZiel + 3).FormulaR1C1 = "=RC[-3]*RC[-1]" 'Preis*Menge
Next
'Zielwertsuche für jeweilige Tageslast
Cells(26, iColZiel).FormulaArray = _
"=INDEX(R30C1:R394C2,MATCH(TEXT(R[-25]C,""TT.MM.""), TEXT(R30C1:R394C1,""TT.MM.""), 0), _
2)"
'Summe Opt.-Tageslast
Cells(26, iColZiel + 2).FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"
'Kosten Opt.-Tageslast
Cells(26, iColZiel + 3).FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"
'Solvereinsatz
SolverOk SetCell:=Cells(26, iColZiel + 3), MaxMinVal:=2, ValueOf:="0", ByChange:=Range( _
Cells(2, iColZiel + 2), Cells(25, iColZiel + 2))
SolverAdd CellRef:=Range(Cells(2, iColZiel + 2), Cells(25, iColZiel + 2)), Relation:=3, _
FormulaText:="0"
SolverAdd CellRef:=Range(Cells(2, iColZiel + 2), Cells(25, iColZiel + 2)), Relation:=1, _
FormulaText:="360"
SolverAdd CellRef:=Cells(26, iColZiel + 2), Relation:=2, FormulaText:=Cells(26, _
iColZiel)
SolverOk SetCell:=Cells(26, iColZiel + 3), MaxMinVal:=2, ValueOf:="0", ByChange:="Range( _
Cells(2, iColZiel + 2), Cells(25, iColZiel + 2))"
SolverSolve UserFinish:=True
SolverReset
iColQuelle = iColQuelle + 1
iColZiel = iColZiel + 4
Loop
End
End Sub
Anzeige