Оптимизация макросов VBA с использованием решателя в Excel не возвращает оптимальные переменные

Я пытаюсь оптимизировать три параметра в Excel, чтобы минимизировать ошибку между экспериментальным значением и теоретическим значением. Я использую Solver для каждого параметра по одному в цикле for. Однако я хочу повторять этот решатель для цикла (цикл внутри цикла) до тех пор, пока ошибка в экспериментальном значении и теоретическом значении не станет меньше некоторого целевого значения.

Мое экспериментальное значение - $K25.
Мое теоретическое значение (рассчитанное на основе уравнений моей модели) - $J$25.
Мои параметры, которые необходимо оптимизировать: $C$4, $C$5, $C$6

Когда я запускаю следующий код VBA, мои параметры в $C$4, $C$5, $C$6 не меняются по сравнению с их начальными значениями. Однако макрос компилируется без ошибок. Может кто-нибудь помочь мне здесь?

Вот код:

Sub Macro3()
    Application.ScreenUpdating = False
    SolverReset
    Dim j As Integer
    For j = 1 To 100 Step 1
        If "$J$25" > "$K$25" Then
            Dim i As Integer, s As String
            For i = 4 To 6 Step 1
            s = Format(i, "0")
                SolverOk SetCell:="$J$25", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$" & s, Engine:= _
                1, EngineDesc:="GRG Nonlinear"
                SolverOptions MaxTime:=0, Iterations:=1000000, Precision:=0.000001, Convergence _
                :=0.00001, StepThru:=False, Scaling:=True, AssumeNonNeg:=True, Derivatives:=1
                SolverOptions PopulationSize:=100, RandomSeed:=0, MutationRate:=0.075, Multistart _
                :=False, RequireBounds:=True, MaxSubproblems:=0, MaxIntegerSols:=0, _
                IntTolerance:=1, SolveWithout:=False, MaxTimeNoImp:=30
                SolverOk SetCell:="$J$25", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$" & s, Engine:= _
                1, EngineDesc:="GRG Nonlinear"
                SolverSolve (True)
                SolverReset
            Next i
        End If
    Next j
    Application.ScreenUpdating = True
End Sub

person user2092724    schedule 20.02.2013    source источник


Ответы (2)


Я не совсем уверен, что вам нужно делать это в VBA, поскольку то, что вы ищете, - это именно то, что должен делать Solver - изменить набор параметров, чтобы что-то еще было максимизировано / минимизировано!

Поэтому все, что вам нужно сделать, это вставить формулу =ABS(J25-K25) в другую ячейку. В этой ячейке будет отображаться разница между экспериментальным и теоретическим значением. Теперь настройте свой Решатель так, чтобы он минимизировал эту ячейку, изменив три ваших параметра - и все готово! (Обратите внимание, что в поле «Изменяя ячейки переменных» можно указать несколько ячеек!)

Если вы хотите придерживаться своего подхода, вот синтаксически правильный код. Обратите внимание, что я не тестировал его, а только исправлял ошибки, которые мог обнаружить, просматривая код. Надеюсь, это будет хорошей отправной точкой. Фактически, глядя на этот подход, я уверен, что вы получите неправильный результат, потому что каждый прогон оптимизирует только одну переменную - и поэтому вы никогда не будете изучать какие-либо эффекты, возникающие в результате комбинации двух или трех параметров. !

Во всяком случае, вот ваш код:

Sub RunSolver()
    Dim j As Integer, i As Integer

    Application.ScreenUpdating = False
    SolverReset

    For j = 1 To 100
        Application.Statusbar = j & "/100"
        If Range("$J$25") > Range("$K$25") Then
            For i = 4 To 6
                SolverOk SetCell:=Range("$J$25"), MaxMinVal:=2, ValueOf:=0, ByChange:=Range("$C$" & i), Engine:= _
                1, EngineDesc:="GRG Nonlinear"
                SolverOptions MaxTime:=0, Iterations:=1000000, Precision:=0.000001, Convergence _
                :=0.00001, StepThru:=False, Scaling:=True, AssumeNonNeg:=True, Derivatives:=1
                SolverOptions PopulationSize:=100, RandomSeed:=0, MutationRate:=0.075, Multistart _
                :=False, RequireBounds:=True, MaxSubproblems:=0, MaxIntegerSols:=0, _
                IntTolerance:=1, SolveWithout:=False, MaxTimeNoImp:=30
                SolverSolve (True)
                SolverReset
            Next i
        End If
    Next j

    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub
person Peter Albert    schedule 20.02.2013
comment
Спасибо! То, что вы предлагаете, правильно. Я вычисляю абсолютное значение общей разницы в моих теоретических уравнениях по сравнению с результатами моих экспериментов. Затем я оптимизирую свои параметры, чтобы минимизировать эту разницу. 25 $ K $ - это моя целевая разница, а 25 $ J $ - моя текущая разница, основанная на параметрах в $ C $ 4, $ C $ 5, $ C $ 6. Итак, да, как вы предлагаете, я мог бы просто использовать решатель, оптимизирующий все три параметра одновременно, и все было бы готово. Однако в конечном итоге я хочу оптимизировать 10 параметров вместо трех по гораздо более сложным уравнениям. А комбинации нескольких параметров будут непростыми! - person user2092724; 21.02.2013
comment
Совершенно уверен, что Solver также может обрабатывать 10 параметров и получать лучшие результаты, чем макрос, оптимизирующий каждый параметр, ошибочно предполагающий при прочих равных! - person Peter Albert; 21.02.2013
comment
Предлагаемый вами код работает. Я только что это проверил. Однако, если 25 $ K $ (целевая разница) установлена ​​ниже значения, на котором сходится Solver, Excel продолжает вычислять и ничего не добивается. Не уверены, знаете ли вы, как быстро этого избежать? - person user2092724; 21.02.2013
comment
как насчет умножения разницы на большой коэффициент? - person Peter Albert; 21.02.2013
comment
Да, решатель может обрабатывать десять параметров. Но, скорее всего, не тогда, когда уравнения, которые у меня есть, сложны и решаются более 100 тыс. Строк. В моем более сложном случае самое большее, что я могу заставить решатель, - это два или три параметра за раз, для которых только один параметр фактически изменяется от своего начального значения в конце. Следовательно, я думал, что делать один параметр за раз - это настолько хорошо, насколько это возможно, хотя я пренебрегаю эффектами одновременного изменения нескольких параметров. Я надеюсь, что повторение каждого параметра в конечном итоге приведет к значимому результату, который физиологически имеет смысл. Еще раз спасибо! - person user2092724; 21.02.2013
comment
Я понимаю. Проверьте наличие альтернативных надстроек решателей. Я помню, что на рынке есть гораздо более мощные решатели, хотя я больше не знаю названия. Также они, скорее всего, не будут бесплатными ... - person Peter Albert; 21.02.2013
comment
Хорошо, я только что проверил свои старые файлы - Решателем был www.solver.com. Они предоставляют бесплатную пробную версию, которая, насколько я помню, полностью функциональна - попробуйте. (Отказ от ответственности: я не связан с ними) - person Peter Albert; 21.02.2013

Вы можете дважды проверить эту строку своего кода, в которой говорится:

Engine:= 1, EngineDesc:="GRG Nonlinear"

Согласно документации MS:

  • 1 для метода Simplex LP,
  • 2 для нелинейного метода GRG, или
  • 3 для эволюционного метода.

Вероятно, ваша целевая функция нелинейна, и вы подумали, что используете нелинейный решатель GRG, поскольку упомянули его в параметре EngineDesc. Что неверно. Это просто параметр описания.

Фактически вы используете решающую программу Simplex LP со значением 1.

Измените значение на 2, чтобы использовать нелинейный решатель GRG.

person Ome    schedule 28.09.2015