19.05.2020, 09:50
Hallo zusammen,
ich versuche gerade eine Schleife so zu dynamisieren, dass ich sie auch für andere Tabellen anwenden kann. Hier einmal eine kurze Erklärung, wie die Schleife vorgehen soll:
Die Schleife soll in Spalte I ab Reihe O + i schauen, ob sich ein Wert in den Zellen befindet. Befindet sich ein Wert in einer Zelle, soll in dieser Reihe der Wert in Spalte AW mittels Solver minimiert werden. Dabei darf der Solver die Gewichte verändern (Spalten AP, AR und AT). Nebenbedingungen sind, dass die Werte in den Spalten AQ, AS und AU gleich groß sein sollen. Die Summe aus den drei Gewichten muss 1 ergeben (Spalte AV). Die Schleife soll so lange durchgeführt werden, bis in Spalte A keine Werte mehr in den Zellen stehen.
Ich habe schon einmal die Reihen bis 97 per Hand optimiert um zu zeigen, wie das Ergebnis aussehen soll. In Reihe 37 habe ich leider schlechte Daten, weshalb der Solver mir kein gutes Ergebnis liefern kann. In Reihe 97 liefert er mir das richtige Ergebnis. Lasse ich meinen Code durchlaufen, dann bleibt Reihe 117 unverändert – sprich wird gar nicht optimiert. Weiß jemand von euch woran das liegen könnte?
Schreibe ich den Code für nur eine Zelle (also ohne O + i sondern nur eine Zeilenzahl) um, dann funktioniert er. Daher dürften die Nebenbedingungen etc. kein Problem sein.
Die Beispieltabelle soll nur einmal zeigen, wie die eigentlichen Tabellen aufgebaut sind. Der Code soll für mehrere Mappen angewendet werden, weshalb ich diesen gerne dynamisch hätte.
Und hier noch der Code:
Sub DoLoop1_1_Erweitert
Dim i As Integer
Dim O As Integer
i = i + 1
O = Cells(6, 13)
Do
If Cells(O + i, 9) = "" Then
i = i + 1
ElseIf Cells(O + i, 9) <> 0 Then
SolverReset
SolverOk SetCell:="$AW$ O + i", MaxMinVal:=2, ValueOf:=0, ByChange:= _
"$AP$ O + i,$AR$ O + i,$AT$ O + i", Engine:=1, EngineDesc:="GRG Nonlinear"
SolverAdd CellRef:="$AQ$ O + i", Relation:=2, FormulaText:="$AS$ O + i"
SolverAdd CellRef:="$AQ$ O + i", Relation:=2, FormulaText:="$AU$ O + i"
SolverAdd CellRef:="$AS$ O + i", Relation:=2, FormulaText:="$AU$ O + i"
SolverAdd CellRef:="$AV$ O + i", Relation:=2, FormulaText:="1"
SolverOk SetCell:="$AW$ O + i", MaxMinVal:=2, ValueOf:=0, ByChange:= _
"$AP$ O + i,$AR$ O + i,$AT$ O + i", Engine:=1, EngineDesc:="GRG Nonlinear"
SolverOk SetCell:="$AW$ O + i", MaxMinVal:=2, ValueOf:=0, ByChange:= _
"$AP$ O + i,$AR$ O + i,$AT$ O + i", Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve 'userfinish:=True
i = i + 1
End If
Loop While Cells(O + i, 1) <> ""
End Sub
Vielen Dank schon einmal für eure Hilfe! :)
ich versuche gerade eine Schleife so zu dynamisieren, dass ich sie auch für andere Tabellen anwenden kann. Hier einmal eine kurze Erklärung, wie die Schleife vorgehen soll:
Die Schleife soll in Spalte I ab Reihe O + i schauen, ob sich ein Wert in den Zellen befindet. Befindet sich ein Wert in einer Zelle, soll in dieser Reihe der Wert in Spalte AW mittels Solver minimiert werden. Dabei darf der Solver die Gewichte verändern (Spalten AP, AR und AT). Nebenbedingungen sind, dass die Werte in den Spalten AQ, AS und AU gleich groß sein sollen. Die Summe aus den drei Gewichten muss 1 ergeben (Spalte AV). Die Schleife soll so lange durchgeführt werden, bis in Spalte A keine Werte mehr in den Zellen stehen.
Ich habe schon einmal die Reihen bis 97 per Hand optimiert um zu zeigen, wie das Ergebnis aussehen soll. In Reihe 37 habe ich leider schlechte Daten, weshalb der Solver mir kein gutes Ergebnis liefern kann. In Reihe 97 liefert er mir das richtige Ergebnis. Lasse ich meinen Code durchlaufen, dann bleibt Reihe 117 unverändert – sprich wird gar nicht optimiert. Weiß jemand von euch woran das liegen könnte?
Schreibe ich den Code für nur eine Zelle (also ohne O + i sondern nur eine Zeilenzahl) um, dann funktioniert er. Daher dürften die Nebenbedingungen etc. kein Problem sein.
Die Beispieltabelle soll nur einmal zeigen, wie die eigentlichen Tabellen aufgebaut sind. Der Code soll für mehrere Mappen angewendet werden, weshalb ich diesen gerne dynamisch hätte.
Und hier noch der Code:
Sub DoLoop1_1_Erweitert
Dim i As Integer
Dim O As Integer
i = i + 1
O = Cells(6, 13)
Do
If Cells(O + i, 9) = "" Then
i = i + 1
ElseIf Cells(O + i, 9) <> 0 Then
SolverReset
SolverOk SetCell:="$AW$ O + i", MaxMinVal:=2, ValueOf:=0, ByChange:= _
"$AP$ O + i,$AR$ O + i,$AT$ O + i", Engine:=1, EngineDesc:="GRG Nonlinear"
SolverAdd CellRef:="$AQ$ O + i", Relation:=2, FormulaText:="$AS$ O + i"
SolverAdd CellRef:="$AQ$ O + i", Relation:=2, FormulaText:="$AU$ O + i"
SolverAdd CellRef:="$AS$ O + i", Relation:=2, FormulaText:="$AU$ O + i"
SolverAdd CellRef:="$AV$ O + i", Relation:=2, FormulaText:="1"
SolverOk SetCell:="$AW$ O + i", MaxMinVal:=2, ValueOf:=0, ByChange:= _
"$AP$ O + i,$AR$ O + i,$AT$ O + i", Engine:=1, EngineDesc:="GRG Nonlinear"
SolverOk SetCell:="$AW$ O + i", MaxMinVal:=2, ValueOf:=0, ByChange:= _
"$AP$ O + i,$AR$ O + i,$AT$ O + i", Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve 'userfinish:=True
i = i + 1
End If
Loop While Cells(O + i, 1) <> ""
End Sub
Vielen Dank schon einmal für eure Hilfe! :)
