Вызов различных решателей на основе выбранного типа ограничения - PullRequest
Новая
       5

Вызов различных решателей на основе выбранного типа ограничения

0 голосов
/ 10 декабря 2018

Я хочу дать пользователю возможность выбирать между тремя различными методами оптимизации, закодированными с 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

Первый метод работает нормально при выборе (прибыль), однако, когда я выбираю и запускаю второй метод (Мощность), он выводит тот же ответ, что и первый.

Кодработает правильно (он пропускает Profit If Then и работает через питание), однако он все еще использует ограничения Profit.

Я еще не настроил третий вариант (Machine Hours).Я пытаюсь заставить первые два функционировать первыми.

...