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

时间:2018-12-10 18:13:53

标签: excel vba solver

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

我还没有设置第三个选项(“机器时间”)。我正在尝试使前两个功能先运行。

0 个答案:

没有答案