在另一张纸上处理VBA解算器时出现奇怪的错误

Question

当我通过VBA使用Solver时，我得到了这个非常奇怪的错误。我的目标和改变单元格在表1中，并且每当我得到一个优化解决方案时，我想将优化后的单元格复制到表格2（我每次优化函数发生更改时都会这样做几次）。如果我在我的求解器程序中添加了Worksheets(1).Select，那么求解器工作正常，并将值粘贴到工作表2。但是，如果我删除了这条语句并且选择了表2而不是表1，那么我在状态栏中看到类似“设置问题...”的东西，然后我得到了错误的结果，而且我的一个奇怪的“0”工作表2.我使用VBA调试器，发现这个“0”值出现在声明Call SolverSolve(True)之后，所以我怀疑这个bug只是在Solver中。仅当活动工作表驻留在更改单元格和目标单元格时，是否必须运行Solver？或者我在哪里做错了？

Option Explicit 
Function SAMPLEONCE() 
'Create one sample from 2500 MI data in worksheets("P2 MI Data"), the sample is 
'stored in worksheets("P2 Sample") 

    Const n As Long = 2500 
    Dim temp As Long 
    Randomize 
    temp = Int(Rnd * 2500) + 1 
    SAMPLEONCE = Worksheets("P2 MI Data").Cells(temp + 1, 1).Resize(1, 6) 
End Function 

Sub SolveItOnce() 

    Call solverreset 
    Call solverok(Worksheets("P2 Sample").Range("Output"), 2, 0, Worksheets("P2 Sample").Range("Input")) 
    Call solversolve(True) 
End Sub 
Sub SolveIt() 
    Dim i As Long, j As Long, k As Long 
    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 
    Worksheets("P2 Sample").Activate 
    For i = 1 To 100 
     'Sampling 
     For j = 1 To 1000 
      Worksheets("P2 Sample").Range("Sample").Rows(j).FormulaArray = "=SAMPLEONCE()" 
     Next j 
     Worksheets("P2 Sample").Range("Sample").Copy 
     Worksheets("P2 Sample").Range("Sample").PasteSpecial Paste:=xlPasteValues 
     'Call Solver 
     For k = 1 To 3 
      Call SolveItOnce 
     Next k 
     'Output result 
     Worksheets("P2 Sample").Range("A2:G2").Copy 
     Worksheets("P2 Result").Range("A1:G1").Offset(i, 0).PasteSpecial Paste:=xlPasteValues 
    Next i 
    Application.Calculation = xlCalculationAutomatic 
End Sub 

Answer 1

我还没有审查的完整代码，但对付日常SolveItOnce ...

Sub SolveItOnce() 

    Call solverreset 
    Call solverok(Worksheets("P2 Sample").Range("Output"), 2, 0, Worksheets("P2 Sample").Range("Input")) 
    Call solversolve(True) 
End Sub 

有一个（因为缺乏一个更好的词）bug associated with the use SolverReset。我建议你省略它。您对SolverOK的电话将会解决您的问题。

当调用SolverOK时，SetCell和ByChange的输入必须是字符串，而不是范围。此外，为了确保求解器参考正确的工作表，最好使用工作表名称“完全限定”字符串中的范围。我建议你的代码看起来像这样（编译但没有测试）...

Sub SolveItOnce() 
Dim myRng As Range, SetAddress As String, ChngAddress As String 

    Set myRng = Worksheets("P2 Sample").Range("Output") 
    SetAddress = Split(myRng.Address(external:=True), "[")(0) & Split(myRng.Address(external:=True), "]")(1) 

    Set myRng = Worksheets("P2 Sample").Range("Input") 
    ChngAddress = Split(myRng.Address(external:=True), "[")(0) & Split(myRng.Address(external:=True), "]")(1) 

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

    Set myRng = Nothing 
End Sub 

这应该防止什么求解正在做什么，你是在调用程序做之间的互动。

设置Application.Calculation = xlCalculationManual不会真的为你做任何事情。求解器要求计算模式是自动的，并设置它。如果你有易变公式（例如使用RAND()或NOW()或RANDBETWEEN()等），你需要做其他一些技巧。

更新 - 为问题更改活动板

我能够迫使求解认识到SetCell和ByChange地址是在比活动板（令人惊讶的困难）等片，丢给下面的错误...

这使我们回到运行求解器之前激活包含求解器问题的工作表。以下内容将保存您的旧活动表单并重新激活它。

Sub SolveItOnce() 
Dim SetRng As Range, ChngRng As Range 
Dim mySht As Worksheet 

    Set mySht = ActiveSheet 
    Worksheets("P2 Sample").Activate 

    Set SetRng = Worksheets("P2 Sample").Range("Output") 
    Set ChngRng = Worksheets("P2 Sample").Range("Input") 

    SolverOk SetCell:=SetRng.Address, MaxMinVal:=3, ValueOf:=1, ByChange:=ChngRng.Address, Engine:=1 
    SolverSolve UserFinish:=True 

    mySht.Activate 
    Set SetRng = Nothing 
    Set ChngRng = Nothing 
    Set mySht = Nothing 
End Sub