Löser in VBA mit Schleifen und Bedingungen

Ich bin insgesamt newbi en VBA und Solver. Ich habe dieses Makro für Excel gemacht:Löser in VBA mit Schleifen und Bedingungen

Sub Macro4() 
' 
' Macro4 Macro 
' Mas4 
' 
' 
SolverOk SetCell:="$CU$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BI$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverOk SetCell:="$CU$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BI$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 
SolverOk SetCell:="$CV$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BJ$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverOk SetCell:="$CV$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BJ$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 
SolverOk SetCell:="$CW$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BK$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverOk SetCell:="$CW$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BK$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 
SolverOk SetCell:="$CX$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BL$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverOk SetCell:="$CX$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BL$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 
SolverOk SetCell:="$CY$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BM$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverOk SetCell:="$CY$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BM$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 
SolverOk SetCell:="$CZ$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BN$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverOk SetCell:="$CZ$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BN$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 
SolverOk SetCell:="$DA$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BO$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverOk SetCell:="$DA$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BO$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 

Range("BI3:BO3").Select 
Selection.Copy 

Range("DI134").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
End Sub

Es funktioniert ok, aber nur für die Zeile 134. Wenn die Bedingung Q134> 125 trifft, dann muss das Makro ausgeführt werden. Ich muss nach anderen Q-Zeilen suchen, die die Bedingung Q (Anzahl der Zeilen)> 125 erfüllten, dann sollte das Makro ausgeführt werden, aber Zeile 134 für "Anzahl der Zeilen" ändern, die die Bedingung erfüllten. Ich weiß nicht, wie ich diese "Number of Row" an eine Referenz für das Macro weitergeben soll.

Wie Sie sehen werden, muss ich die Solver-Ausgabe jedes Mal speichern, wenn das Makro ausgeführt wird, aber ich weiß nicht, wie es geht. Das ist der Grund warum ich benutzt habe:

Range("DI134").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False

im letzten Teil meines Makros.

Vielen Dank im Voraus und Entschuldigung für meine Unerfahrenheit.

Quelle

2016-04-28 E. Tron

'weiß nicht, wie man dieses" numbre of row "übergibt, verwende eine Variable. – findwindow

sieht so aus, als ob Sie SolverOk zweimal für jeden Solver-Lauf verwenden. Man sollte genügen. Ich verwende gerne SolverReset, um sauber zu starten. Sie müssen einen Schritt hinzufügen, um die Lösung jedes Durchgangs zu kopieren. Sie sollten wahrscheinlich eine VBA-Schleife über die Bereiche von OF-Zellen und DV-Zellen verwenden. Sie können die Schleife für die Variable Zeilennummer mit etwas wie diesem tun: 'für i = 134 bis 144' ' wenn Bereich ("Q" & i) .value> 125 dann " ' Aufruf macro4' 'endif ' ' nächste i' – kindoflost

@ E.Tron - bitte überprüfen Sie die Antwort unter [dieser Beitrag] (http://stackoverflow.com/questions/36671991/use-solver-in-vba-with-loop-in-rows) und lassen Sie mich wissen, wenn Sie weitere Fragen haben. – OldUgly

Unten finden Sie eine Routine, die tun könnte, was Sie in ...

interessiert sind

Sub SolveRow(myRow As Long) 
Dim iLoop As Long 
Dim SetRng As Range, ChngRng As Range 
Dim mySht As Worksheet 
Dim SetAddress As String, ChngAddress As String 
' 
' 
    Set mySht = Worksheets("Sheet4") 
    For iLoop = 1 To 7 
     Set SetRng = mySht.Range(mySht.Cells(myRow, iLoop + 98), mySht.Cells(myRow, iLoop + 98)) 
     SetAddress = Split(SetRng.Address(external:=True), "[")(0) & Split(SetRng.Address(external:=True), "]")(1) 
     Set ChngRng = mySht.Range(mySht.Cells(3, iLoop + 60), mySht.Cells(3, iLoop + 60)) 
     ChngAddress = Split(ChngRng.Address(external:=True), "[")(0) & Split(ChngRng.Address(external:=True), "]")(1) 

     SolverOk SetCell:=SetAddress, MaxMinVal:=3, ValueOf:=1, ByChange:=ChngAddress, Engine:=1 
     SolverSolve UserFinish:=True 
    Next iLoop 

    mySht.Range("BI3:BO3").Copy 
    mySht.Range("DI" & myRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

    Set mySht = Nothing 
End Sub

Dies kann durch eine andere VBA Routine aufgerufen werden, berechnet, welche Zeile bestimmt werden muss. z.B. ...

Sub main() 
Dim theRow As Long 
    theRow = 134 
    SolveRow (theRow) 
End Sub

Lassen Sie uns die SolveRow sub unterteilen. Auf der Linie ...

Set mySht = Worksheets("Sheet4")

... sollten Sie "Sheet4" ändern, um der Name des Arbeitsblatts zu sein, das Ihre Formeln enthält.

Die Schleife ...

For iLoop = 1 To 7 
    ... 
Next iLoop

... does 7 Iterationen. Die Nummer, die Sie in Ihrem ursprünglichen Code hatten.

Die Linien den Wert für die Bestimmung sind SetCell ...

Set SetRng = mySht.Range(mySht.Cells(myRow, iLoop + 98), mySht.Cells(myRow, iLoop + 98)) 
    SetAddress = Split(SetRng.Address(external:=True), "[")(0) & Split(SetRng.Address(external:=True), "]")(1)

... definiert die erste Linie den Bereich. 'iLoop + 98' geht von 99 bis 105, was den Spalten CU bis DA entspricht. Die zweite Zeile ergibt eine Zeichenfolge mit dem vollqualifizierten Bereich - etwa Sheet4!$CU$134.

Die Linien den Wert für die Bestimmung sind ByChange ...

Set ChngRng = mySht.Range(mySht.Cells(3, iLoop + 60), mySht.Cells(3, iLoop + 60)) 
    ChngAddress = Split(ChngRng.Address(external:=True), "[")(0) & Split(ChngRng.Address(external:=True), "]")(1)

... es scheint, dass man immer Werte in Zeile 3, ändern sich so ist es schwer, codiert. iLoop + 60 entspricht den Spalten BI bis BO.

Hinweis:

SolverReset nicht aufgerufen wird. Es verursacht Probleme beim Einstellen des manuellen Berechnungsmodus. In SolverOK wird nur Engine:=1 angegeben. Wenn Sie beide Engine:=1, EngineDesc:="GRG Nonlinear" angeben, erhalten Sie unerwartetes Verhalten. (Das Problem wird nicht neu definiert, und das erste Problem wird 7 Mal gelöst).

Die beiden Linien, ziemlich viel, was Sie hatten, ...

mySht.Range("BI3:BO3").Copy 
mySht.Range("DI" & myRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False

... tun, um die Copy/Paste-Operation. Auch hier gehe ich davon aus, dass die dritte Zeile immer kopiert werden soll, also ist der Bereich fest codiert. Wenn es anders sein sollte, können die oben verwendeten Techniken verwendet werden, um den korrekten Bereich zu spezifizieren. Ich nehme auch an, dass Sie in der gleichen Reihe einfügen möchten, in der Sie den Solver calc in gemacht haben.

Quelle

2016-04-30 21:30:30 OldUgly

uffff, ich denke dein Level ist zu hoch für mein Wissen. Aber danke, alles in allem. –

Vielen Dank. Ich werde einen Blick darauf werfen, aber es übertrifft mein Wissen in VBA zu sehr. –

Ich denke, dass ich gefunden habe, wie man die Zellzahlen als Referenz übergibt. Zum Beispiel SolverOk SetCell: = "CU" & i

Jetzt ist mein Makro so und es funktioniert ok:

Sub Macro7() 

Dim i As Long 
Dim k As Long 
k = 0 
Dim s As Long 
s = 1 

For i = 8 To 77806 
k = k + 1 

If Range("Q" & i) > 125 Then 
s = i - k + 1 
k = 0 

SolverOk SetCell:="CU" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BI$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 
SolverOk SetCell:="CV" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BJ$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 
SolverOk SetCell:="CW" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BK$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 
SolverOk SetCell:="CX" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BL$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 
SolverOk SetCell:="CY" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BM$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 
SolverOk SetCell:="CZ" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BN$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 
SolverOk SetCell:="DA" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BO$3", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve UserFinish:=True 

Range("BI3:BO3").Select 
Selection.Copy 
Range("DI" & i).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Range("CU" & i & ":DA" & i).Select 
Selection.Copy 
Range("DB" & i).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 

Range("BP" & s & ":BV" & i).Select 
Selection.Copy 
Range("DP" & s).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
End If 

Next i 

End Sub

Wie Sie ich habe sehen können andere Dinge hinzugefügt ich brauchte.

Vielen Dank an alle. Gutes Forum.

Quelle

2016-05-01 22:23:11

Löser in VBA mit Schleifen und Bedingungen

Antwort

Verwandte Themen