Aufruf von Excel-Solver von einem anderen Sub gibt andere Ergebnisse als manuell

Question

Ich brauche Solver in einem Blatt ("Sheet1") für verschiedene Werte eines Parameters namens "Luft", dieser Parameter ist nicht Teil der Parameter von Solver, aber es hat einen Einfluss auf die Ergebnisse, also erstelle ich eine Tabelle in "Sheet2" mit verschiedenen Werten von "air" und habe einen Code erstellt, um Solver für jeden "air" -Wert auszuführen, um einige Ergebnisse von Sheet1 "wiederherzustellen" und sie einzufügen die gleiche Tabelle in "Tabelle2"

Dies ist der Code, den ich für "Tabelle2" made

Sub F1() 
    Dim air() As Variant 
    air = Selection.Value 'Selection of different % of "air" from a table in Sheet2 
    i = UBound(air, 1) 'Length of air array 
    For j = 1 To i 
    Sheet1.Range("$H$35").Value = air(j, 1) 'Change parameter "air" of Sheet1 
    Call Sheet1.Resolver 'Run Solver on Sheet1 to obtain new results 
    ActiveCell.Offset(j - 1, 1).Value = Sheet1.Range("$P$132").Value 'Paste new result "$P$132" from Sheet1 on a cell one space right to "air" in table from Sheet2 
    ActiveCell.Offset(j - 1, 2).Value = Sheet1.Range("$A$54").Value 'Paste new result "$A$54" from Sheet1 on a cell two spaces right to "air" in table from Sheet2 
    ActiveCell.Offset(j - 1, 3).Value = Sheet1.Range("$P$117").Value 'Paste new result "$P$117" from Sheet1 on a cell three spaces right to "air" in table from Sheet2 
    Next j 
End Sub 

Und das ist die Unter Resolver von Sheet1:

Dieser Code funktioniert, aber ich bekomme falsche Werte, wenn ich sie mit Ergebnissen vergleichen, die manuell mit dem Sub Resolver erhalten werden. Zum Beispiel:

den ersten Code verwenden:

air  x  y   z 
0,10 56,52 35,08  7.093,49 
0,20 56,52 35,08  5.716,48 
0,30 56,52 35,08  4.787,19 
0,35 56,52 35,08  4.427,32 

den zweiten Code manuell:

air x  y  z 
0,10 74,29 57,79 9.324,50 
0,20 67,19 48,13 6.796,69 
0,30 60,08 39,43 5.089,14 
0,35 56,52 35,08 4.427,32 

auf den Ergebnissen aus dem ersten Code nur die letzte Zeile in Ordnung ist, denn bevor F1 läuft Ich führe Resolver manuell mit einem Wert von 0,35 von "Luft". Wenn ich die Reihenfolge der "Luft" -Werte ändere, sind sie gleich, nur 0,35 Zeilen sind in Ordnung.

Dann erkannte ich, dass in "Sheet2" nach dem Ausführen von F1 die Werte der Zellen $ A $ 51, $ H $ 36: $ H $ 38, $ A $ 54, $ A $ 45, $ A $ 47, $ A $ 49 (das gleiche verwendet in Resolver) sind 0, so jetzt denke ich, dass das Problem ist, dass Resolver auf "Sheet2" statt "Sheet1" läuft. Also habe ich folgendes versucht:

Sub Resolver() 
    SolverReset 
    SolverOk SetCell:=Sheet1.Range("$A$51"), MaxMinVal:=3, ValueOf:="0", ByChange:=Sheet1.Range("$H$36:$H$38,$A$54"), Engine:=1 
    SolverAdd CellRef:=Sheet1.Range("$A$45"), Relation:=2, FormulaText:=0 
    SolverAdd CellRef:=Sheet1.Range("$A$47"), Relation:=2, FormulaText:=0 
    SolverAdd CellRef:=Sheet1.Range("$A$49"), Relation:=2, FormulaText:=0 
    SolverOptions AssumeNonNeg:=False 
    SolverSolve UserFinish:=True 
    SolverFinish KeepFinal:=1 
End Sub 

Aber funktioniert nicht, wie kann ich "Resolver" in "Sheet1" ausführen? Vielen Dank!

Answer 1

Gelöst, ich weiß nicht, ob es schmutziger Code ist oder nicht, aber funktioniert.

Hinzufügen von dem folgenden Code auf F1:

Sheet1.Select 

Vor Resolver Aufruf.

Und

Sheet2.Select 

Um die Daten zu Tabelle2 und "Einfügen" zurück.

Dann:

Sub F1() 
On Error GoTo errHandler 
Application.ScreenUpdating = False 

Dim air() As Variant 
air = Selection.Value 'Selection of different % of "air" from a table in Sheet2 
i = UBound(air, 1) 'Length of air array 

For j = 1 To i 
Sheet1.Range("$H$35").Value = air(j, 1) 'Change parameter "air" of Sheet1 
Sheet1.Select 
Call Sheet1.Resolver 'Run solver on Sheet1 to obtain new results 
Sheet2.Select 
ActiveCell.Offset(j - 1, 1).Value = Sheet1.Range("$P$132").Value 'Paste new results "$P$132" from Sheet1 on a cell 1 space right to "air" in table from Sheet2 
ActiveCell.Offset(j - 1, 2).Value = Sheet1.Range("$A$54").Value 'Paste new results "$A$54" from Sheet1 on a cell 2 spaces right to "air" in table from Sheet2 
ActiveCell.Offset(j - 1, 3).Value = Sheet1.Range("$P$117").Value 'Paste new results "$P$117" from Sheet1 on a cell 3 spaces right to "air" in table from Sheet2 
Next j 

Application.ScreenUpdating = True 
errHandler: 
Application.ScreenUpdating = True 
End Sub 

Mit

Sub F1() 
On Error GoTo errHandler 
Application.ScreenUpdating = False 
....(code)... 
....(code)... 
Application.ScreenUpdating = True 
errHandler: 
Application.ScreenUpdating = True 
End sub 

Um zu vermeiden, zwischen Blattwechsel flackern.