AW: Zielw. soll nach jed Durchlauf um 1 erhöht werden
06.11.2013 16:01:58
Der
Hallo mf,
hier ein Makro-Beispiel für eine Solver-Lösung.
Diese musst du natürlich an deine Solver-Einstellungen und Randbedingungen anpassen.
Ich bin mir aber nicht sicher, ob der etwas schwache Makro-Rekorder unter Excel 2007 dir weiterhilft.
mfg
Franz
'Erstellt unter Excel 2010, teilweise mit Makrorecorder
'vor dem Start des Makrorecorders im VBA-Editor unter Extras--Verweise den Solver aktivieren
Sub Solver_Variieren()
' Makro3 Makro
Dim Zeile As Long
Dim Wert As Double, StartZielwert As Double, EndZielwert As Double, Schritt As Double
With ActiveSheet
Zeile = 9 'Startzeile für Ergebnisse
StartZielwert = .Range("B7") 'Startwert für Solver-Zielwertberechnungen
EndZielwert = .Range("D7") 'Endwert für Solver-Zielwertberechnungen
Schritt = .Range("F7") 'Schrittweite für Solver-Zielwertberechnungen
Wert = StartZielwert
Application.ScreenUpdating = False
Do
SolverReset
'Solverparameter setzen
'SetCell = Zielzelle mit der Berechnungsformel
'MaxMinVal = 1 = Max, 2 = Min, 3 = Wert
'ValueIf = Wertvorgabe für MaxMinVal:=3
'ByChange = veränderliche Zelle(n)
SolverOk SetCell:="$E$5", MaxMinVal:=3, ValueOf:=Wert, ByChange:="$D$2,$D$3", _
Engine:=1, EngineDesc:="GRG Nonlinear"
'Randbedingungen einfügen - diese mit dem Recorder aufzeichnen und einfügen
SolverAdd CellRef:="$D$5", Relation:=2, FormulaText:="1" 'Summe der Mischungsanteile
'Application.SendKeys "%o", Wait:=True 'Sendet Alt+o an den Solverdialog
If Solversolve(True) = 5 Then '5 = keine Lösung gefunden
'Ergebnisse in Tabelle eintragen
.Cells(Zeile, 1) = "keine Lsg." 'Anteile Sand 1
.Cells(Zeile, 2) = "keine Lsg." 'Anteile Sand 2
.Cells(Zeile, 3) = "keine Lsg." 'Anteile Sand 3
.Cells(Zeile, 4) = Wert 'Zielwert
Else
'Ergebnisse in Tabelle eintragen
.Cells(Zeile, 1) = .Cells(2, 4).Value 'Anteile Sand 1
.Cells(Zeile, 2) = .Cells(3, 4).Value 'Anteile Sand 2
.Cells(Zeile, 3) = .Cells(4, 4).Value 'Anteile Sand 3
.Cells(Zeile, 4) = Wert 'Zielwert
End If
Wert = Wert + Schritt
Zeile = Zeile + 1
Loop Until VBA.Round(Wert, 5) > VBA.Round(EndZielwert, 5)
End With 'ActiveSheet
Application.ScreenUpdating = True
End Sub