Sub DWP()
Dim vVar As String
Dim kvar As String
Dim changev As Range
Dim off As Integer
Dim con As Integer
Dim kchange As Double
Dim vchange As Double
Dim mini As Integer
Dim donum As Integer
Dim SelNum As Integer
'Application.ScreenUpdating = False
donum = -15
mini = 10
off = 57
con = 0
SelNum = -57
Sheets("Solver").Select
Range("B71").Select
Call ValSet
Call Opter
Range("B18").Select
Call valOf
Range("B71").Select
Call Opter
Range("B71").Select
con = 1
kchange = -0.5
vchange = 0.5
Call Opter
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = 1
vchange = 1
Call Opter
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = 0.5
vchange = -0.5
Call Opter
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = -0.5
vchange = -0.5
Call Opter
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = 0.5
vchange = 0.5
Call OpterUnconst
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = -0.5
vchange = 0.5
Call OpterUnconst
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = 0.5
vchange = -0.5
Call OpterUnconst
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = 10
vchange = 1
Call OpterUnconst
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = 5
vchange = 1
Call OpterUnconst
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = 1
vchange = 5
Call OpterUnconst
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = 2
vchange = 50
Call OpterUnconst
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = -5
vchange = 0.5
Call OpterUnconst
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = -10
vchange = 10
Call OpterUnconst
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = -10
vchange = 1
Call OpterUnconst
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = 1
vchange = 10
Call OpterUnconst
Range("B18").Select
'Call valOf
Range("B71").Select
kchange = -0.5
vchange = -0.5
Call OpterUnconst
Range("B18").Select
'Call valOf
con = 0
Range("N73").Select
Call Opter
Range("N73").Select
con = 1
kchange = 1
vchange = 1
Call Opter
Range("N73").Select
'con = 1
kchange = 0.123
vchange = 0.321
Call Opter
Range("N73").Select
kchange = -0.5
vchange = 0.5
Call Opter
Range("N73").Select
kchange = 0.5
vchange = -0.5
Call Opter
Range("N73").Select
kchange = -0.5
vchange = -0.5
Call Opter
Range("N73").Select
kchange = 0.5
vchange = 0.5
Call OpterUnconst
Range("N73").Select
kchange = -0.5
vchange = 0.5
Call OpterUnconst
Range("N73").Select
kchange = 0.5
vchange = -0.5
Call OpterUnconst
Range("N73").Select
kchange = 5
vchange = 1
Call OpterUnconst
Range("N73").Select
kchange = 1
vchange = 5
Call OpterUnconst
Range("N73").Select
kchange = -0.5
vchange = -0.5
Call OpterUnconst
Range("AB71").Select
con = 0
Call Opter3
Range("AB71").Select
con = 1
kchange = -3
Call Opter3
Range("AK71").Select
Call Opter4
con = 0
mini = 1
donum = 2
off = 3
Range("BB16").Select
Call valOf2
Range("BP16").Select
Call valOf2
Range("AV25").Select
Call OpterUnconstr
Range("AV12").Select
Call OpterUnconstr
Range("BJ25").Select
Call OpterUnconstr
Range("BJ12").Select
Call OpterUnconstr
con = 0
mini = 0
donum = -2
off = 49
SelNum = -49
Range("BP59").Select
Call OpterUnconstr
Range("BB59").Select
Call OpterUnconstr
SolverReset
End Sub
Sub ValSet()
'Application.ScreenUpdating = False
Range("B9:J10, AB9:AH9").Value = 0.5
Range("N9:O10, Q9:U10, W9:W10, X10").Value = -0.5
Range("P9").Value = 2
Range("P10").Value = -2.5
Range("AK9:AP9").Value = 0.75
Range("V9").Value = -0.005
Range("v10").Value = 0.05
Range("x9").Value = -0.05
End Sub
Sub Opter()
'Application.ScreenUpdating = False
'Call Module1.Iterations
Do While IsEmpty(ActiveCell.Offset(donum, 0)) = False
If mini = 1 Then
Call selecterMini
Else
Call selecter
End If
Set changev = Selection
ActiveCell.Offset(off, 0).Select
On Error GoTo erhand
If ActiveCell.Value > 950 Then
If con = 1 Then
Range(kvar).Value = kchange
Range(vVar).Value = vchange
Else
End If
'Application.Run "SolverReset"
'Application.Run "SolverOk", "ActiveCell.Address", 3, "0", "changev.Address"
'Application.Run "SolverAdd", "kvar", 1, "Range(kvar).Offset(-1, 0).value"
'Application.Run "SolverAdd", "kvar", 3, "Range(kvar).Offset(-2, 0).value"
'Application.Run "SolverAdd", "vvar", 1, "Range(vVar).Offset(-4, 0).value"
'Application.Run "SolverAdd", "vvar", 3, "Range(vVar).Offset(-5, 0).value"
'Application.Run "SolverSolve", True
SolverReset
SolverOptions AssumeNonNeg:=False, Derivatives:=2
SolverOk SetCell:=ActiveCell.Address, _
MaxMinVal:=3, _
ValueOf:=0, _
ByChange:=changev.Address
SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).Value
SolverAdd CellRef:=kvar, Relation:=3, FormulaText:=Range(kvar).Offset(-2, 0).Value
SolverAdd CellRef:=vVar, Relation:=1, FormulaText:=Range(vVar).Offset(-4, 0).Value
SolverAdd CellRef:=vVar, Relation:=3, FormulaText:=Range(vVar).Offset(-5, 0).Value
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
Else
erhand:
Resume Next
ActiveCell.Offset(0, 1).Select
End If
Loop
'Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub valOf()
'Application.ScreenUpdating = False
Do While IsEmpty(ActiveCell.Offset(-2, 0)) = False
If ActiveCell.Value = "Run Opt.1" Then
SolverReset
SolverOk SetCell:=ActiveCell.Offset(1, 0).Address, _
MaxMinVal:=3, _
ValueOf:=0, _
ByChange:=Selection.Offset(2, 0).Address
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop
End Sub
Sub valOf2()
'Application.ScreenUpdating = False
Do While IsEmpty(ActiveCell.Offset(-3, 0)) = False
If ActiveCell.Value = "Run Opt.1" Then
SolverReset
SolverOk SetCell:=ActiveCell.Offset(1, 0).Address, _
MaxMinVal:=3, _
ValueOf:=0, _
ByChange:=Selection.Offset(2, 0).Address
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop
End Sub
Sub OpterUnconst()
'Application.ScreenUpdating = False
'Call Module1.Iterations
Do While IsEmpty(ActiveCell.Offset(donum, 0)) = False
If mini = 1 Then
Call selecterMini
Else
Call selecter
End If
Set changev = Selection
ActiveCell.Offset(off, 0).Select
On Error GoTo erhand
If ActiveCell.Value > 950 Or ActiveCell < -500 Then
If con = 1 Then
Range(kvar).Value = kchange
Range(vVar).Value = vchange
Else
End If
SolverReset
SolverOptions AssumeNonNeg:=False, Derivatives:=2
SolverOk SetCell:=ActiveCell.Address, _
MaxMinVal:=3, _
ValueOf:=0, _
ByChange:=changev.Address
SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).Value + 2
SolverAdd CellRef:=kvar, Relation:=3, FormulaText:=Range(kvar).Offset(-2, 0).Value - 2
SolverAdd CellRef:=vVar, Relation:=1, FormulaText:=Range(vVar).Offset(-4, 0).Value + 15
SolverAdd CellRef:=vVar, Relation:=3, FormulaText:=Range(vVar).Offset(-5, 0).Value - 15
'SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).value
'SolverAdd CellRef:=kvar, Relation:=3, FormulaText:="0.0001"
'SolverAdd CellRef:=vVar, Relation:=1, FormulaText:=Range(vVar).Offset(-4, 0).value
'SolverAdd CellRef:=vVar, Relation:=3, FormulaText:="0.0001"
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
Else
erhand:
Resume Next
ActiveCell.Offset(0, 1).Select
End If
Loop
'Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub OpterUnconstr()
'Application.ScreenUpdating = False
'Call Module1.Iterations
Do While IsEmpty(ActiveCell.Offset(donum, 0)) = False
If mini = 1 Then
Call selecterMini
Else
Call selecter
End If
Set changev = Selection
ActiveCell.Offset(off, 0).Select
On Error GoTo erhand
If ActiveCell.Value > 0.95 Or ActiveCell < -0.5 Then
If con = 1 Then
Range(kvar).Value = kchange
Range(vVar).Value = vchange
Else
End If
SolverReset
SolverOptions AssumeNonNeg:=False, Derivatives:=2
SolverOk SetCell:=ActiveCell.Address, _
MaxMinVal:=3, _
ValueOf:=0, _
ByChange:=changev.Address
'SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).value + 2
'SolverAdd CellRef:=kvar, Relation:=3, FormulaText:=Range(kvar).Offset(-2, 0).value - 2
'SolverAdd CellRef:=vVar, Relation:=1, FormulaText:=Range(vVar).Offset(-4, 0).value + 15
'SolverAdd CellRef:=vVar, Relation:=3, FormulaText:=Range(vVar).Offset(-5, 0).value - 15
'SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).value
'SolverAdd CellRef:=kvar, Relation:=3, FormulaText:="0.0001"
'SolverAdd CellRef:=vVar, Relation:=1, FormulaText:=Range(vVar).Offset(-4, 0).value
'SolverAdd CellRef:=vVar, Relation:=3, FormulaText:="0.0001"
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
Else
erhand:
Resume Next
ActiveCell.Offset(0, 1).Select
End If
Loop
'Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Opter3()
'Application.ScreenUpdating = False
'Call Module1.Iterations
Do While IsEmpty(ActiveCell.Offset(-10, 0)) = False
Call selecter3
Set changev = Selection
ActiveCell.Offset(57, 0).Select
On Error GoTo erhand
If ActiveCell.Value > 950 Or ActiveCell.Value < -0.1 Then
'MsgBox ActiveCell.value
If con = 1 Then
Range(kvar).Value = kchange
Else
End If
SolverReset
SolverOptions AssumeNonNeg:=True, Derivatives:=2
SolverOk SetCell:=ActiveCell.Address, _
MaxMinVal:=3, _
ValueOf:=0, _
ByChange:=kvar
SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).Value
SolverAdd CellRef:=kvar, Relation:=3, FormulaText:=Range(kvar).Offset(-2, 0).Value
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
Else
erhand:
Resume Next
ActiveCell.Offset(0, 1).Select
End If
Loop
'Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Opter4()
'Application.ScreenUpdating = False
'Call Module1.Iterations
Do While IsEmpty(ActiveCell.Offset(-13, 0)) = False
Call selecter3
Set changev = Selection
ActiveCell.Offset(57, 0).Select
SolverReset
SolverOptions AssumeNonNeg:=True, Derivatives:=2
SolverOk SetCell:=ActiveCell.Address, _
MaxMinVal:=2, _
ByChange:=kvar
SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).Value
SolverAdd CellRef:=kvar, Relation:=3, FormulaText:=Range(kvar).Offset(-2, 0).Value
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
'erhand:
'Resume Next
'ActiveCell.Offset(0, 1).Select
Loop
'Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub selecter()
'Application.ScreenUpdating = False
ActiveCell.Offset(SelNum, 0).Select
kvar = ActiveCell.Address
ActiveCell.Offset(1, 0).Select
vVar = ActiveCell.Address
ActiveCell.Offset(-1, 0).Select
ActiveCell.Resize(2).Select
End Sub
Sub selecter3()
'Application.ScreenUpdating = False
ActiveCell.Offset(-57, 0).Select
kvar = ActiveCell.Address
End Sub
Sub selecterMini()
ActiveCell.Offset(-3, 0).Select
kvar = ActiveCell.Address
ActiveCell.Offset(1, 0).Select
vVar = ActiveCell.Address
ActiveCell.Offset(-1, 0).Select
ActiveCell.Resize(2).Select
End Sub
Sub it2()
'Range("B9:J10").value = 0.5
'MsgBox kvar & " " & vVar
'MsgBox Range(kvar).Offset(-2, 0).value
Application.Run "SolverReset"
Application.Run "SolverOk", "ActiveCell.Address", 3, "0", "changev.Address"
Application.Run "SolverAdd", "kvar", 1, "Range(kvar).Offset(-1, 0).value"
Application.Run "SolverAdd", "kvar", 3, "Range(kvar).Offset(-2, 0).value"
Application.Run "SolverAdd", "vvar", 1, "Range(vVar).Offset(-4, 0).value"
Application.Run "SolverAdd", "vvar", 3, "Range(vVar).Offset(-5, 0).value"
Application.Run "SolverSolve", True
End Sub