iT邦幫忙

1

[VBA] SolverAdd 無法加入條件

大家好,
我用EXCEL的規劃求解功能做一個產線排程自動分配的工具,
但遇到一個問題一直無解,找了網上的資料,但一直找不到答案...
有看到也有人跟我遇到相同的狀況

我目前程式操作順序是
規劃求解 >> 加入排程(複製(2)案貼到(3)) >> 二次規劃求解
一次規劃求解是正常的,規劃求解條件也有進去,
但第二次跑卻有一個條件沒有進去,
第一次正常但第二次卻不行,我看了很久又GOOGLE找資料但還是看不出來錯在哪,
想問各位大大到底是我程式寫錯還是規劃求解功能的問題?

下方有附介面圖片與程式碼 或從雲端下載檔案(EXCEL)也可以

GOOGLE雲端
https://drive.google.com/file/d/1BvmW0AkSvEO2b2fsDlmD_dO6cSQXbJdF/view

  1. 限制條件
  2. 規劃求解解出來的內容
  3. 排程區
    https://ithelp.ithome.com.tw/upload/images/20180510/20104887poTeDBAvlc.jpg

第一次 規劃求解 條件都有進去
https://ithelp.ithome.com.tw/upload/images/20180510/20104887MrL6qdxVWi.jpg
加入排程(將結果複製到右邊並扣總數量)
https://ithelp.ithome.com.tw/upload/images/20180510/20104887RBc4DJ8eeC.jpg
第二次 規劃求解 B7條件怎麼試都沒辦法加進去,手動可以但用SolverAdd無法
https://ithelp.ithome.com.tw/upload/images/20180510/20104887IqbMDifH0W.jpg
規劃求解 按鍵 的 程式碼

Private Sub CommandButton1_Click()

Dim i As Integer

Dim DD As Date

Worksheets("工作表1").Activate
SolverReset

If Application.WorksheetFunction.Sum(Range("B2:B7")) <= 0 Then
 MsgBox "沒有訂單了!!"
 Exit Sub
End If

i = 2

Do Until i > 7

 If Cells(i, 2) > 0 Then
  SolverAdd cellRef:=Range("B" & i + 8), _
  relation:=1, _
  formulaText:=Cells(i, 2)
 Else
  SolverAdd cellRef:=Range("B" & i + 8), _
  relation:=2, _
  formulaText:=0
 End If
 
 i = i + 1

Loop

SolverOk SetCell:=Range("C16"), _
 MaxMinVal:=1, _
 ByChange:=Range("B10:B15")
 Engine = 3
 
SolverAdd cellRef:=Range("B10:B15"), _
 relation:=4
 
SolverAdd cellRef:=Cells(16, 3), _
 relation:=1, _
 formulaText:=Cells(2, 9)
 
SolverSolve userFinish:=True
SolverFinish KeepFinal:=1

DD = Cells(16, 1)

Cells(16, 1) = DD + 1

End Sub

尚未有邦友回答

立即登入回答