在另一張紙上處理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