求解器在循环中运行不正常,在执行所有243组合之前崩溃

时间:2018-04-02 16:14:15

标签: vba excel-vba loops crash solver

我制作了这个代码来运行带有Evolutionary Engine的Excel Solver,通过一个按钮自动调用Excel Solver并运行它,共进行了81次组合3次(做Solver 243次),而不是手动操作。

81个组合是4个变量的3个级别的结果: convergence,mutationRate,populationSize,MaxTimeNoImp

我遇到的问题是,当我尝试多次执行81次组合时(在这种情况下循环是3次),Excel文件崩溃了。 大多数情况下,如果我评论循环部分,代码运行良好,但在极少数情况下,Excel文件也会崩溃。

我该怎么做才能防止这种情况发生?

无论如何我可以避免这个问题吗?

如果我无法避免,我是否至少可以保存所取得的进展,并且在我再次打开Excel文件之前让Solver从它停止的位置开始运行?

'here i delete the previous data

ultimo = Cells(9, Columns.Count).End(xlToLeft).Column
Worksheets("Folha1").Range(Cells(8, 23), Cells(129, ultimo)).ClearContents

Cells(9, 23) = "histórico"
Cells(11, 23) = "makespan médio"
Cells(14, 23) = "makespan minimo"
Cells(17, 23) = "desvio padrao"
Cells(20, 23) = "num simulações"
Cells(23, 23) = "tempo em min"

Dim StartTime As Date
StartTime = Now()

Dim convergence(2) As Double
Dim mutationRate(2) As Double
Dim populationSize(2) As Integer
Dim MaxTimeNoImp(2) As Integer

'define the 3 levels of each variable

convergence(0) = 0.0001
convergence(1) = 0.0005
convergence(2) = 0.001

mutationRate(0) = 0.001
mutationRate(1) = 0.002
mutationRate(2) = 0.005

populationSize(0) = 30
populationSize(1) = 50
populationSize(2) = 70

MaxTimeNoImp(0) = 10
MaxTimeNoImp(1) = 15
MaxTimeNoImp(2) = 40

'loop

For aa = 1 To 3
    'check all combinations

    For Z = LBound(convergence) To UBound(convergence)
            'make the changeable data equal for the beginning of every combination
        For q = 11 To 110
            Cells(q, 1) = q - 10
        Next q

        For x = LBound(mutationRate) To UBound(mutationRate)
            For q = 11 To 110
                Cells(q, 1) = q - 10
            Next q

            For c = LBound(populationSize) To UBound(populationSize)
                For q = 11 To 110
                    Cells(q, 1) = q - 10
                Next q

                For v = LBound(MaxTimeNoImp) To UBound(MaxTimeNoImp)
                    For q = 11 To 110
                        Cells(q, 1) = q - 10
                    Next q

                   'delete previous constraints

                    On Error GoTo b:
                    SolverDelete CellRef:="$A$11:$A$110", Relation:=3, FormulaText:="1"
                    SolverDelete CellRef:="$A$11:$A$110", Relation:=1, FormulaText:="100"
                    SolverDelete CellRef:="$A$11:$A$110", Relation:=6, FormulaText:="TudoDiferente"
                    SolverDelete CellRef:="$A$11:$A$110", Relation:=4, FormulaText:="número inteiro"
b:

                    'solver options using the combinations

                    SolverOptions MaxTime:=0, Iterations:=0, Precision:=0.000001, convergence:= _
                        convergence(Z), StepThru:=False, Scaling:=True, AssumeNonNeg:=True, Derivatives:=1

                    SolverOptions populationSize:=populationSize(c), RandomSeed:=0, mutationRate:=mutationRate(x), Multistart _
                        :=False, RequireBounds:=True, MaxSubproblems:=0, MaxIntegerSols:=0, _
                        IntTolerance:=0.1, SolveWithout:=False, MaxTimeNoImp:=MaxTimeNoImp(v)

                    'add constraints

                    SolverAdd CellRef:="$A$11:$A$110", Relation:=3, FormulaText:="1"
                    SolverAdd CellRef:="$A$11:$A$110", Relation:=1, FormulaText:="100"
                    SolverAdd CellRef:="$A$11:$A$110", Relation:=6, FormulaText:="TudoDiferente"
                    SolverAdd CellRef:="$A$11:$A$110", Relation:=4, FormulaText:="número inteiro"

                    'change A11:A110 cells, objetive cell L110, Evolutionary Method

                    SolverOk SetCell:="$L$110", MaxMinVal:=2, ValueOf:=0, ByChange:="$A$11:$A$110", _
                        Engine:=3, EngineDesc:="Evolutionary"

                    'solve and make response report

                    SolverSolve True
                    SolverFinish KeepFinal:=1, ReportArray:=Array(1)

                    'get the time that it took that is always in cells(7,2)

                    Dim tempo As String
                    tempo = Sheets("Relatório de Resposta 1").Cells(7, 2)
                    Dim partir() As String
                    partir = Split(tempo, ":")

                    'get the column name and write the time it took

                    a = Cells(9, Columns.Count).End(xlToLeft).Column

                    Cells(9, a + 1) = "tempo de simulação"
                    Cells(10, a + 1) = partir(1)

                    'delete report

                    Application.DisplayAlerts = False
                    Sheets("Relatório de Resposta 1").Delete

                    'write the time it finished,the combination used,the final result, and sequence obtained

                    Cells(12, a + 1) = Now

                    Cells(14, a + 1) = "makespan"
                    Cells(15, a + 1) = Cells(110, 12)

                    Cells(17, a + 1) = "convergence"
                    Cells(18, a + 1) = convergence(Z)

                    Cells(20, a + 1) = "mutationRate"
                    Cells(21, a + 1) = mutationRate(x)

                    Cells(23, a + 1) = "populationSize"
                    Cells(24, a + 1) = populationSize(c)

                    Cells(26, a + 1) = "MaxTimeNoImp"
                    Cells(27, a + 1) = MaxTimeNoImp(v)

                    Cells(29, a + 1) = "sequência"

                    For p = 30 To 129
                        Cells(p, a + 1) = Cells(p - 19, 1)
                    Next p
                Next v
            Next c
        Next x
    Next Z
Next aa

'write 1º combination,2º combination,3 combination till 81 combination

For i = 24 To 104
    Cells(8, i).Value = i - 23
Next i

For i = 105 To 185
    Cells(8, i).Value = i - 104
Next i

For i = 186 To 266
    Cells(8, i).Value = i - 185
Next i

'order by combination as key1 and final result as key2
'it will be 1 combination 1 combination 1 combination 2 combination .....

Range(Cells(8, 24), Cells(129, a + 1)).Sort Key1:=Range(Cells(8, 24), Cells(8, a + 1)), Key2:=Range(Cells(15, 2), Cells(15, a + 1)), _
Order1:=xlAscending, Orientation:=xlLeftToRight

'average and minimum final result,standart deviation, number of combinations made, time it took since the button was pushed

Cells(11, 23) = "makespan medio"
Cells(12, 23) = Application.Average(Range(Cells(15, 24), Cells(15, a + 1)))

Cells(14, 23) = "makespan minimo"
Cells(15, 23) = Application.WorksheetFunction.Min(Range(Cells(15, 24), Cells(15, a + 1)))

Cells(17, 23) = "desvio padrao"
Cells(18, 23) = Application.WorksheetFunction.StDev(Range(Cells(15, 24), Cells(15, a + 1)))

Cells(20, 23) = "num simulacoes"
Cells(21, 23) = (Cells(9, Columns.Count).End(xlToLeft).Column) - 23

Cells(23, 23) = "tempo em min"
Cells(24, 23) = (Now() - StartTime) * 24 * 36

Columns.AutoFit

Screenshot for better undestanding

0 个答案:

没有答案