excel - 根据选择的约束类型调用不同的求解器

Question

我想让用户选择使用 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 约束。

我还没有设置第三个选项（机器时间）。我试图让前两个首先发挥作用。

标签： excelvbasolver