Excel Makro für Solver for Schleife

Pulipet · 11. November 2019 um 18:27

Hallo liebe wer-weiß-was community,

ich bin auf der Suche nach einer For Schleife (hoffe das heißt so) für meine Excel Sheet. Um euch einen Eindruck zu vermitteln um was es geht hab ich euch mal ein Makro aufgezeichnet:

Sub Makro4()
’
’ Makro4 Makro
’

’
SolverOk SetCell:="$M$32", MaxMinVal:=2, ValueOf:=„0“, ByChange:="$M$27:blush:V$27"
SolverDelete CellRef:="$M$31", Relation:=2, FormulaText:="$M$39"
SolverAdd CellRef:="$M$31", Relation:=2, FormulaText:="$M$38"
SolverOk SetCell:="$M$32", MaxMinVal:=2, ValueOf:=„0“, ByChange:="$M$27:blush:V$27"
SolverSolve
Range(„M33“).Select
Selection.Copy
Range(„L38“).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
SolverOk SetCell:="$M$32", MaxMinVal:=2, ValueOf:=„0“, ByChange:="$M$27:blush:V$27"
SolverDelete CellRef:="$M$31", Relation:=2, FormulaText:="$M$38"
SolverAdd CellRef:="$M$31", Relation:=2, FormulaText:="$M$39"
SolverOk SetCell:="$M$32", MaxMinVal:=2, ValueOf:=„0“, ByChange:="$M$27:blush:V$27"
SolverSolve
Range(„M33“).Select
Selection.Copy
Range(„L39“).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
SolverOk SetCell:="$M$32", MaxMinVal:=2, ValueOf:=„0“, ByChange:="$M$27:blush:V$27"
SolverDelete CellRef:="$M$31", Relation:=2, FormulaText:="$M$39"
SolverAdd CellRef:="$M$31", Relation:=2, FormulaText:="$M$40"
SolverOk SetCell:="$M$32", MaxMinVal:=2, ValueOf:=„0“, ByChange:="$M$27:blush:V$27"
SolverSolve
Range(„M33“).Select
Selection.Copy
Range(„L40“).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Wie ihr sehen könnt habe ich drei mal das gleiche gemacht. den solver geöffnet, eine Nebenbedingung geändert, den solver durchgeführt und ein Ergebnis in die entsprechende Zeile kopiert. Meine Frage ist nun, ob die Möglichkeit besteht das dreimalige Wiederholen mit einer „einfachen“ For Schleife zu bewältigen.
mein Excel Sheet geht nämlich noch einige Zeilen weiter, und den Solver jedes mal per Hand auszuführen dauert ewig.

Ich hoffe, ich konnte euch das Problem einigermaßen verständlich schildern.

Ich freue mich auf eure Antworten, bis dahin vielen Dank vorab.

viele Grüße
Peter

Thomas_Ramel · 11. November 2019 um 18:27

Grüezi Pulipet

Schau mal ob die folgenden Zeilen korrekt durchlaufen - ich kann sie mangels Solver-Modell nicht testen:

Sub tr\_Solver()
Dim intI As Integer

For intI = 1 To 3 'Anzahl der Durchläufe

 SolverDelete CellRef:="$M$31", Relation:=2, FormulaText:="$M$39"
 SolverAdd CellRef:="$M$31", Relation:=2, FormulaText:=Range("M37").Offset(intI).Address
 SolverOk SetCell:="$M$32", MaxMinVal:=2, ValueOf:="0", ByChange:="$M$27:blush:V$27"
 SolverSolve

 Range("L37").Offset(intI, 0).Value = Range("M32").Offset(intI, 0).Value

 Next intI
End Sub

Mit freundlichen Grüssen

Thomas Ramel

MVP für MS-Excel -

Pulipet · 11. November 2019 um 18:27

Hi Thomas,
vielen Dank für deinen Post, allerdings funktioniert das Makro nicht so wie es soll. =(
ich hab es folgendermaßen eingebaut:

Sub makro3()
Dim intI As Integer

For intI = 1 To 3

SolverDelete CellRef:="$M$31", Relation:=2, FormulaText:="$M$39"
SolverAdd CellRef:="$M$31", Relation:=2, FormulaText:=Range(„M37“).Offset(intI).Address
SolverOk SetCell:="$M$32", MaxMinVal:=2, ValueOf:=„0“, ByChange:="$M$27:blush:V$27"
SolverSolve

Range(„L37“).Offset(intI, 0).Value = Range(„M32“).Offset(intI, 0).Value

Next intI

End Sub

wenn ich es mit meinem aufgezeichneten makro vergleiche, fällt mir auf, dass du die ein oder andere Zeile (z.B. die erste Zeile) gelöscht hast.

hier ist noch mal mein original skript nach aufzeichnung:

Sub Makro2()
’
’ Makro2 Makro
’ Makro am 10.11.2010 von Peter Pulino aufgezeichnet
’

’
SolverOk SetCell:="$M$32", MaxMinVal:=2, ValueOf:=„0“, ByChange:="$M$27:blush:V$27"
SolverDelete CellRef:="$M$31", Relation:=2, FormulaText:="$M$38"
SolverAdd CellRef:="$M$31", Relation:=2, FormulaText:="$M$38"
SolverOk SetCell:="$M$32", MaxMinVal:=2, ValueOf:=„0“, ByChange:="$M$27:blush:V$27"
SolverSolve
Range(„M33“).Select
Selection.Copy
Range(„L38“).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

wäre super, wenn du dich meiner noch einmal annehmen könntest. Ich habe zwar selbst probiert, den Code zu adjustieren, aber Solver mach dann irgendwelche verrückten Sachen und ich bekomm nicht die gewünschte Lösung.

Vielen dank und viele Grüße
Peter

Thomas_Ramel · 11. November 2019 um 18:27

Grüezi Pulipet

Die gelöschte Zeile ist/war doppelt vorhanden.

Aber wie gesagt, ohne dein Solver-Modell kann ich da nicht wirklich etwas testen.

Erstelle also eine 1:1 Demo-Mappe, lade sie auf einen Webspace hoch und nenne dann hier den Link, sonst kommen wir nicht wirklich weiter, fürchte ich.

Mit freundlichen Grüssen

Thomas Ramel

MVP für MS-Excel -

Pulipet · 11. November 2019 um 18:33

Hi Thomas,
hab die datei jetzt endlich hochgeladen, sorry, dass das so lang gedauert hat, hab gestern und vorgestern selbst versucht was zu finden, aber leider erfolglos.
hier ist der link: http://www.file-upload.net/download-2965825/ToF-v0.0…

hier das neue makro:

Sub Makro2()
’
’ Makro2 Makro
’ Makro am 12.11.2010 von Peter Pulino aufgezeichnet
’

'schleife start
For i = 1 To 3
'copy zelle B38, B39 usw. in hilfszelle „B34“
'Solve
SolverOk SetCell:="$B$32", MaxMinVal:=2, ValueOf:=„0“, ByChange:="$B$27:blush:K$27"
SolverSolve
Range(„B33“).Select
Selection.Copy
Range(„A38“).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next i
'schleife ende
End Sub

wie du siehst hab ich den solver etwas angepasst, damit das makro nichts daran ändern muss, jetzt gilt es nur noch einzustellen, dass das makro die von mir erstellte hilfszelle per schleife jedes mal verändert und der neue wert für die SD kopiert wird. kümmer dich nicht um die spalten sharpe ration und cml, das ist dann wieder ne andere baustelle für die ich allerdings kein makro brauche.
hoffe, du kannst mir weiterhelfen.
vielen dank und beste grüße
peter

Thomas_Ramel · 11. November 2019 um 18:33

Grüezi Peter

Ja, mit der Demo-Mappe geht das doch gleich vieeel leicher.

Verwende das folgende Makro, das mit dem Range-Objekt arbeitet - ich mag diese Vorgehensweise lieber als die Zählschleifen.
Wenn sich der Bereich deiner Zellen verändert passe diesen einfach im Makro ganz zu Beginn an (oder wir überlegen uns, wie wir das Ganze noch automatisieren können).

Sub Makro\_tr()
Dim rngZelle As Range

 'schleife start
 'copy zelle B38, B39 usw. in hilfszelle "B34"
 For Each rngZelle In Range("B38:B63")
 Range("B34").Value = rngZelle.Value

 'Solve
 SolverOk SetCell:="$B$32", MaxMinVal:=2, ValueOf:="0", ByChange:="$B$27:blush:K$27"
 SolverSolve True

 'Daten übertragen
 rngZelle.Offset(0, -1).Value = Range("B33").Value

 'schleife ende
 Next rngZelle
End Sub

Mit freundlichen Grüssen

Thomas Ramel

MVP für MS-Excel -

Reinhard_fb8cb7 · 11. November 2019 um 18:33

OT Verweise setzen in Vba
Grüezi Thomas,

in der hochgeladenen Mappe sah ich im Editor in der Modulliste links auch „Verweise“ mit dem Unterpunkt „Verweis auf Solver.xla“.

Ich verstehe grad nicht wie man sowas erzeugt.
Wenn ich in Excel über den Add-In-manager den Solver einbinde so erscheint bei mir nix, nichtmal die Solver.xla links im VB-Editor.

Steh ich grad wiedermal auf’m Schlauch?

Excel 2000

Danke ^ Gruß
Reinhard

Pulipet · 11. November 2019 um 18:33

Hi Thomas,
das war super, hat perfekt funktioniert!
meinst du wir könnten noch ne funktion adden?
würde gerne die „weights“ die der solver als „veränderbare zellen“ annimmt separat speichern. da diese bei jedem einzelnen solverdurchlauf verloren gehen bzw. wieder neu angepasst werden, dachte hier an etwas wie dies:

Sub Makro2()

Dim rngZelle As Range

'schleife start
'copy zelle B38, B39 usw. in hilfszelle „B34“
For Each rngZelle In Range(„B38:B79“)
Range(„B34“).Value = rngZelle.Value

'Solve
SolverOk SetCell:="$B$32", MaxMinVal:=2, ValueOf:=„0“, ByChange:="$B$27:blush:K$27"
SolverSolve True

'Daten übertragen
rngZelle.Offset(0, -1).Value = Range(„B33“).Value
'NEU: zeilen $B$27:blush:K$27 copy paste an anderen ort (egal wo)
'schleife ende
Next rngZelle
'End Sub
End Sub

wär super wenn du darauf auch noch ne antwort hättest, danach bist du auch entlassen. wenn nicht ist natürlich auch nicht schlimm, hast mir schon unglaublich viel geholfen, kannst dir gar nicht vorstellen wie viel arbeit du mir erspart hast.

Vielen Dank
peter

Thomas_Ramel · 11. November 2019 um 18:33

Grüezi Reinhard

in der hochgeladenen Mappe sah ich im Editor in der Modulliste
links auch „Verweise“ mit dem Unterpunkt „Verweis auf
Solver.xla“.

Ich verstehe grad nicht wie man sowas erzeugt.

Vermutlich im VBA-Editor über Extras/Verweise.

Das alleinige einbinden des Solver-Addins erzeugt in der Mappe keinen Verweis, der muss ‚manuell‘ hinzugefügt werden (obschon das anderweitig auch wieder Probleme macht / machen kann).

Mit freundlichen Grüssen

Thomas Ramel

MVP für MS-Excel -

Thomas_Ramel · 11. November 2019 um 18:33

Grüezi Peter

das war super, hat perfekt funktioniert!

Fein, das freut mich

würde gerne die „weights“ die der solver als „veränderbare
zellen“ annimmt separat speichern. da diese bei jedem
einzelnen solverdurchlauf verloren gehen bzw. wieder neu
angepasst werden, dachte hier an etwas wie dies:

Verwende den Block, den ich unten eingefügt habe, dann werden diese Werte gleich in dieselbe Zeile geschrieben wie der Wert, der zuvor kopiert worden ist. Auf dies Weise ist die Zuordnung der Werte relativ einfach.

Sub Makro2()

Dim rngZelle As Range

'schleife start
'copy zelle B38, B39 usw. in hilfszelle „B34“
For Each rngZelle In Range(„B38:B79“)
Range(„B34“).Value = rngZelle.Value

'Solve
SolverOk SetCell:="$B$32", MaxMinVal:=2, ValueOf:=„0“,
ByChange:="$B$27:blush:K$27"
SolverSolve True

'Daten übertragen
rngZelle.Offset(0, -1).Value = Range(„B33“).Value
'NEU: zeilen $B$27:blush:K$27 copy paste an anderen ort (egal wo)

 'Daten übertragen
 rngZelle.Offset(0, -1).Value = Range("B33").Value
 rngZelle.Offset(0, 4).Resize(1, 10).Value = Range("B27:K27").Value

'schleife ende
Next rngZelle
'End Sub
End Sub

Mit freundlichen Grüssen

Thomas Ramel

MVP für MS-Excel -

Pulipet · 11. November 2019 um 18:33

Hi again,

das war schon wieder super!
hat bestens geklappt!
bin jetzt vorerst wunschlos glücklich!
Vielen, vielen Dank

Grützli, peter

Ps: ich meld mich bestimmt die tage mal wieder