从另一个 sub 调用 Excel Solver 给出的结果与手动给出的结果不同
Calling Excel Solver from another sub is giving different results than manually
我需要运行求解器中的一个sheet("Sheet1")一个参数的不同值叫"air",这个参数不是参数的一部分解算器,但它对结果有影响,所以我在 "Sheet2" 中创建了一个 table,具有不同的 "air" 值,并为每个 [=] 编写了一个 运行 解算器代码35=] 值到 "recover" 来自 Sheet1 的一些结果,并将它们放在 "Sheet2"
中相同的 table
这是我为 "Sheet2"
编写的代码
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").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("$P2").Value 'Paste new result "$P2" from Sheet1 on a cell one space right to "air" in table from Sheet2
ActiveCell.Offset(j - 1, 2).Value = Sheet1.Range("$A").Value 'Paste new result "$A" from Sheet1 on a cell two spaces right to "air" in table from Sheet2
ActiveCell.Offset(j - 1, 3).Value = Sheet1.Range("$P7").Value 'Paste new result "$P7" from Sheet1 on a cell three spaces right to "air" in table from Sheet2
Next j
End Sub
这是工作表 1 中的子解析器:
Sub Resolver()
SolverReset
SolverOk SetCell:=Range("$A"), MaxMinVal:=3, ValueOf:="0", ByChange:=Range("$H:$H,$A"), Engine:=1
SolverAdd CellRef:=Range("$A"), Relation:=2, FormulaText:=0
SolverAdd CellRef:=Range("$A"), Relation:=2, FormulaText:=0
SolverAdd CellRef:=Range("$A"), Relation:=2, FormulaText:=0
SolverOptions AssumeNonNeg:=False
SolverSolve UserFinish:=True
SolverFinish KeepFinal:=1
End Sub
此代码有效,但如果我将它们与手动获得的结果进行比较,我会得到错误的值 运行使用子解析器。例如:
使用第一个代码:
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
手动使用第二个代码:
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
在第一个代码的结果中,只有最后一行是可以的,因为在 运行ning F1 之前,我 运行 手动解析器的值为 "air" 的 0,35。如果我更改 "air" 值的顺序,它们是相同的,只有 0.35 行是可以的。
然后我意识到在 "Sheet2" 中 运行ning F1 单元格 $A$51、$H$36:$H$38、$A$54、$A$45、$A$47 的值, $A$49(与 Resolver 中使用的相同)为 0,所以现在我认为问题是 Resolver 在 "Sheet2" 而不是 "Sheet1" 上 运行ning。所以我尝试了以下方法:
Sub Resolver()
SolverReset
SolverOk SetCell:=Sheet1.Range("$A"), MaxMinVal:=3, ValueOf:="0", ByChange:=Sheet1.Range("$H:$H,$A"), Engine:=1
SolverAdd CellRef:=Sheet1.Range("$A"), Relation:=2, FormulaText:=0
SolverAdd CellRef:=Sheet1.Range("$A"), Relation:=2, FormulaText:=0
SolverAdd CellRef:=Sheet1.Range("$A"), Relation:=2, FormulaText:=0
SolverOptions AssumeNonNeg:=False
SolverSolve UserFinish:=True
SolverFinish KeepFinal:=1
End Sub
但是不工作,我如何在"Sheet1"中运行 "Resolver"?谢谢!
已解决,不知道是不是脏代码,但是可以用。
在 F1 上添加以下代码:
Sheet1.Select
在调用 Resolver 之前。
和
Sheet2.Select
返回工作表 2 和 "paste" 数据。
然后:
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").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("$P2").Value 'Paste new results "$P2" from Sheet1 on a cell 1 space right to "air" in table from Sheet2
ActiveCell.Offset(j - 1, 2).Value = Sheet1.Range("$A").Value 'Paste new results "$A" from Sheet1 on a cell 2 spaces right to "air" in table from Sheet2
ActiveCell.Offset(j - 1, 3).Value = Sheet1.Range("$P7").Value 'Paste new results "$P7" 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
有
Sub F1()
On Error GoTo errHandler
Application.ScreenUpdating = False
....(code)...
....(code)...
Application.ScreenUpdating = True
errHandler:
Application.ScreenUpdating = True
End sub
避免 sheet 变化之间的闪烁。
我需要运行求解器中的一个sheet("Sheet1")一个参数的不同值叫"air",这个参数不是参数的一部分解算器,但它对结果有影响,所以我在 "Sheet2" 中创建了一个 table,具有不同的 "air" 值,并为每个 [=] 编写了一个 运行 解算器代码35=] 值到 "recover" 来自 Sheet1 的一些结果,并将它们放在 "Sheet2"
中相同的 table这是我为 "Sheet2"
编写的代码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").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("$P2").Value 'Paste new result "$P2" from Sheet1 on a cell one space right to "air" in table from Sheet2
ActiveCell.Offset(j - 1, 2).Value = Sheet1.Range("$A").Value 'Paste new result "$A" from Sheet1 on a cell two spaces right to "air" in table from Sheet2
ActiveCell.Offset(j - 1, 3).Value = Sheet1.Range("$P7").Value 'Paste new result "$P7" from Sheet1 on a cell three spaces right to "air" in table from Sheet2
Next j
End Sub
这是工作表 1 中的子解析器:
Sub Resolver()
SolverReset
SolverOk SetCell:=Range("$A"), MaxMinVal:=3, ValueOf:="0", ByChange:=Range("$H:$H,$A"), Engine:=1
SolverAdd CellRef:=Range("$A"), Relation:=2, FormulaText:=0
SolverAdd CellRef:=Range("$A"), Relation:=2, FormulaText:=0
SolverAdd CellRef:=Range("$A"), Relation:=2, FormulaText:=0
SolverOptions AssumeNonNeg:=False
SolverSolve UserFinish:=True
SolverFinish KeepFinal:=1
End Sub
此代码有效,但如果我将它们与手动获得的结果进行比较,我会得到错误的值 运行使用子解析器。例如:
使用第一个代码:
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
手动使用第二个代码:
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
在第一个代码的结果中,只有最后一行是可以的,因为在 运行ning F1 之前,我 运行 手动解析器的值为 "air" 的 0,35。如果我更改 "air" 值的顺序,它们是相同的,只有 0.35 行是可以的。
然后我意识到在 "Sheet2" 中 运行ning F1 单元格 $A$51、$H$36:$H$38、$A$54、$A$45、$A$47 的值, $A$49(与 Resolver 中使用的相同)为 0,所以现在我认为问题是 Resolver 在 "Sheet2" 而不是 "Sheet1" 上 运行ning。所以我尝试了以下方法:
Sub Resolver()
SolverReset
SolverOk SetCell:=Sheet1.Range("$A"), MaxMinVal:=3, ValueOf:="0", ByChange:=Sheet1.Range("$H:$H,$A"), Engine:=1
SolverAdd CellRef:=Sheet1.Range("$A"), Relation:=2, FormulaText:=0
SolverAdd CellRef:=Sheet1.Range("$A"), Relation:=2, FormulaText:=0
SolverAdd CellRef:=Sheet1.Range("$A"), Relation:=2, FormulaText:=0
SolverOptions AssumeNonNeg:=False
SolverSolve UserFinish:=True
SolverFinish KeepFinal:=1
End Sub
但是不工作,我如何在"Sheet1"中运行 "Resolver"?谢谢!
已解决,不知道是不是脏代码,但是可以用。
在 F1 上添加以下代码:
Sheet1.Select
在调用 Resolver 之前。
和
Sheet2.Select
返回工作表 2 和 "paste" 数据。
然后:
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").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("$P2").Value 'Paste new results "$P2" from Sheet1 on a cell 1 space right to "air" in table from Sheet2
ActiveCell.Offset(j - 1, 2).Value = Sheet1.Range("$A").Value 'Paste new results "$A" from Sheet1 on a cell 2 spaces right to "air" in table from Sheet2
ActiveCell.Offset(j - 1, 3).Value = Sheet1.Range("$P7").Value 'Paste new results "$P7" 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
有
Sub F1()
On Error GoTo errHandler
Application.ScreenUpdating = False
....(code)...
....(code)...
Application.ScreenUpdating = True
errHandler:
Application.ScreenUpdating = True
End sub
避免 sheet 变化之间的闪烁。