我想让用户可以选择使用VBA编码的三种不同的优化方法:利润,功率和机器工时。每种方法将使用不同的约束。用户单击下拉菜单并选择方法,然后单击调用此程序的“优化”按钮。
Public Sub RunOptimization()
Dim targetVal As Single
Dim rownum, result, i As Integer
Dim constraintType As String
constraintType = ActiveSheet.Range("F16").Value
If (constraintType = "Profit") Then
'# first delete the output worksheet
If Not GetWorksheet(OUTPUT_SHEET) Is Nothing Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(OUTPUT_SHEET).Delete
Application.DisplayAlerts = True
End If
Application.Run "Solver.xlam!SolverReset"
ThisWorkbook.Worksheets(MODEL_SHEET).Activate
ThisWorkbook.Worksheets(MODEL_SHEET).Activate
'https://docs.microsoft.com/en-us/office/vba/excel/concepts/functions/solverok-function
'# 1 - maximize
'# 2 - minimize
'# 3 - match a specific value
Application.Run "Solver.xlam!SolverOk", "model!H33", 1, "model!N11", "GRG Nonlinear" ' set up new analysis
' add constraints - https://msdn.microsoft.com/en-us/vba/excel-vba/articles/solveradd-function
'# 1 : <=
'# 2 : =
'# 3 : >=
'# Add the constraints here
Application.Run "Solver.xlam!SolverAdd", "model!H14", 1, "model!H13"
Application.Run "Solver.xlam!SolverAdd", "model!K14", 1, "model!K13"
Application.Run "Solver.xlam!SolverAdd", "model!N14", 1, "model!N13"
Application.Run "Solver.xlam!SolverAdd", "model!P21", 1, "model!P20"
result = Application.Run("Solver.xlam!SolverSolve", True)
If result <= 3 Then
Debug.Print "Solution found"
'# this copies the results to the output page
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = OUTPUT_SHEET
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("B1").Value = "Optimized output"
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("B3").Value = "Units of A"
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("B4").Value = "Units of B"
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("B5").Value = "Units of C"
ThisWorkbook.Sheets(MODEL_SHEET).Activate
ThisWorkbook.Sheets(MODEL_SHEET).Range("h11").Select
Selection.Copy
ThisWorkbook.Sheets(OUTPUT_SHEET).Activate
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("c3").PasteSpecial Paste:=xlPasteValues
'# copy B units
ThisWorkbook.Sheets(MODEL_SHEET).Activate
ThisWorkbook.Sheets(MODEL_SHEET).Range("k11").Select
Selection.Copy
ThisWorkbook.Sheets(OUTPUT_SHEET).Activate
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("c4").PasteSpecial Paste:=xlPasteValues
'# copy C units
ThisWorkbook.Sheets(MODEL_SHEET).Activate
ThisWorkbook.Sheets(MODEL_SHEET).Range("n11").Select
Selection.Copy
ThisWorkbook.Sheets(OUTPUT_SHEET).Activate
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("c5").PasteSpecial Paste:=xlPasteValues
Else
'Call MsgBox("Solver was unable to find a solution.", vbExclamation, "SOLUTION NOT FOUND")
Call MsgBox("Solver unable to find a solution")
End If
ElseIf (constraintType = "Power") Then
'# first delete the output worksheet
If Not GetWorksheet(OUTPUT_SHEET) Is Nothing Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(OUTPUT_SHEET).Delete
Application.DisplayAlerts = True
End If
Application.Run "Solver.xlam!SolverReset"
ThisWorkbook.Worksheets(MODEL_SHEET).Activate
ThisWorkbook.Worksheets(MODEL_SHEET).Activate
'https://docs.microsoft.com/en-us/office/vba/excel/concepts/functions/solverok-function
'# 1 - maximize
'# 2 - minimize
'# 3 - match a specific value
Application.Run "Solver.xlam!SolverOk", "model!H33", 1, "model!N11", "GRG Nonlinear" ' set up new analysis
' add constraints - https://msdn.microsoft.com/en-us/vba/excel-vba/articles/solveradd-function
'# 1 : <=
'# 2 : =
'# 3 : >=
'# Add the constraints here
Application.Run "Solver.xlam!SolverAdd", "model!H14", 1, "model!H13"
Application.Run "Solver.xlam!SolverAdd", "model!K14", 1, "model!K13"
Application.Run "Solver.xlam!SolverAdd", "model!N14", 1, "model!N13"
result = Application.Run("Solver.xlam!SolverSolve", True)
If result <= 3 Then
Debug.Print "Solution found"
'# this copies the results to the output page
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = OUTPUT_SHEET
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("B1").Value = "Optimized output"
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("B3").Value = "Units of A"
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("B4").Value = "Units of B"
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("B5").Value = "Units of C"
ThisWorkbook.Sheets(MODEL_SHEET).Activate
ThisWorkbook.Sheets(MODEL_SHEET).Range("h11").Select
Selection.Copy
ThisWorkbook.Sheets(OUTPUT_SHEET).Activate
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("c3").PasteSpecial Paste:=xlPasteValues
'# copy B units
ThisWorkbook.Sheets(MODEL_SHEET).Activate
ThisWorkbook.Sheets(MODEL_SHEET).Range("k11").Select
Selection.Copy
ThisWorkbook.Sheets(OUTPUT_SHEET).Activate
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("c4").PasteSpecial Paste:=xlPasteValues
'# copy C units
ThisWorkbook.Sheets(MODEL_SHEET).Activate
ThisWorkbook.Sheets(MODEL_SHEET).Range("n11").Select
Selection.Copy
ThisWorkbook.Sheets(OUTPUT_SHEET).Activate
ThisWorkbook.Sheets(OUTPUT_SHEET).Range("c5").PasteSpecial Paste:=xlPasteValues
Else
'Call MsgBox("Solver was unable to find a solution.", vbExclamation, "SOLUTION NOT FOUND")
Call MsgBox("Solver unable to find a solution")
End If
ElseIf (constraintType = "Machine hours") Then
End If
Application.CutCopyMode = False
End Sub
Private Function GetWorksheet(shtName As String) As Worksheet
On Error Resume Next
Set GetWorksheet = Worksheets(shtName)
End Function
第一种方法在被选中(利润)时运行良好,但是当我选择并运行第二种方法(“ Power”)时,它会输出与第一种方法相同的答案。
该代码正在正常运行(它跳过了“ Profit If Then”并通过电源运行),但是它仍在使用“ Profit”约束。
我还没有设置第三个选项(“机器时间”)。我正在尝试使前两个功能先运行。