Alguém sabe se o Solver rodado via VBA aceita como referência vetores ao invés de células??
Preciso otimizar uma rotina de 60 horas e creio que a única forma é fazer os cálculos "por dentro", mas usando vetores o solver não dá pau mas também não retorna os resultados.
Pergunta
Guest --Fred --
Alguém sabe se o Solver rodado via VBA aceita como referência vetores ao invés de células??
Preciso otimizar uma rotina de 60 horas e creio que a única forma é fazer os cálculos "por dentro", mas usando vetores o solver não dá pau mas também não retorna os resultados.
Sub Solver_FINAL()
Application.ScreenUpdating = False
Dim DadosEnt(2186, 133) As Double
Dim DadosEnt2(2186, 4) As Double
Dim Coef(133) As Double
For i = 1 To 2186
For j = 1 To 133
If ActiveSheet.Cells(i + 5, j + 10) = "" Then
DadosEnt(i, j) = 0
Else
DadosEnt(i, j) = ActiveSheet.Cells(i + 5, j + 10)
DadosEnt2(i, 1) = ActiveSheet.Cells(i + 5, 2)
DadosEnt2(i, 2) = ActiveSheet.Cells(i + 5, 3)
DadosEnt2(i, 3) = ActiveSheet.Cells(i + 5, 5)
DadosEnt2(i, 4) = ActiveSheet.Cells(i + 5, 8)
End If
Next j
Next i
fim = False
For i = 16 To 16
For j = 1 To 133
Coef(j) = DadosEnt(i, j)
Next j
SolverReset
SolverOk SetCell:=DadosEnt2(i, 2), MaxMinVal:=2, ValueOf:="0", ByChange:=Coef 'Range(Cells(Contlin, 11), Cells(Contlin, 143))
SolverAdd CellRef:=DadosEnt2(i, 3), Relation:=2, FormulaText:="1"
SolverAdd CellRef:=DadosEnt2(i, 4), Relation:=2, FormulaText:="1"
SolverAdd CellRef:=DadosEnt2(i, 1), Relation:=2, FormulaText:="0"
'SolverAdd CellRef:=Range(Cells(Contlin, 11), Cells(Contlin, 143)), Relation:=3, FormulaText:="0"
SolverAdd CellRef:=Coef, Relation:=3, FormulaText:="0"
SolverOptions MaxTime:=10000, Iterations:=100, Precision:=0.000001, _
AssumeLinear:=False, StepThru:=False, Estimates:=1, Derivatives:=1, _
SearchOption:=1, IntTolerance:=5, Scaling:=False, Convergence:=0.0001, _
AssumeNonNeg:=False
SolverOk SetCell:=DadosEnt2(i, 2), MaxMinVal:=2, ValueOf:="0", ByChange:=Coef 'Range(Cells(Contlin, 11), Cells(Contlin, 143))
SolverSolve UserFinish:=True
SolverFinish KeepFinal:=1
fim = True
Next i
For i = 16 To 16
For j = 1 To 133
If DadosEnt(i, j) = 0 Then
ActiveSheet.Cells(i + 5, j + 10) = ""
Else
ActiveSheet.Range(Cells(i + 5, j + 10), Cells(i + 5, j + 131)) = Coef(j)
'ActiveSheet.Cells(i + 5, 2) = DadosEnt2(i, 1)
'ActiveSheet.Cells(i + 5, 3) = DadosEnt2(i, 2)
'ActiveSheet.Cells(i + 5, 5) = DadosEnt2(i, 3)
'ActiveSheet.Cells(i + 5, 8) = DadosEnt2(i, 4)
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Link para o comentário
Compartilhar em outros sites
1 resposta a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.