Programming and Application(编程与应用)

Use VBA script to control Solver

Zhanshan Dong

We usually use Excel to store a lot of data. To process these data, especially
fit nonlinear model, is complicated. Excel provides a optimization tool called 
Solver that can be utilized to solve nonlinear problem numerically. In the past, 
we have experiences to solve neural network in Excel. If you run the Excel Solver
from the Tools menu, you can only solve one problem at a time. Sometimes we have
a lot of data grouped into many groups. We need solve a nonlinear equation for
each group separately. You can manully do it by clicking the Excel menu items. It
will be a tedious and error-prone process. Is it possible to use VBA subroutine to 
call the solver automatically and loop through a given data set? Answer is yes. 
I provide a simple VBA script code here. The sample spreadsheet is a right start 
point if you'd like to apply this VBA script to your problems.


' Source code 
' This macro is used to optimize nonlinear euqations in Excel
' It call Excel Solver to do the optimization
' In order to use the solver, you have to add the Excel Solver to 
' the VBA project that will use this macro
'
' Write by Zhanshan Dong, Sept 2007
'
' Data should be in current active sheet
' You have to organize your data in the format similar to the sample sheet
' Please download the sample sheet and modify it to adapt to your particular 
' situation
'
' In this example, the problem we try to solve has 4 parameters
' Data 
'
Dim initParams(4) As Double
Dim maxA As Double
Dim optimParams(5) As Double
Dim mySheet As Worksheet

Sub optim()
    Set mySheet = ActiveSheet
    For j = 5 To 16 Step 4
        mySheet.Cells(7, 20).Value = j
        maxA = WorksheetFunction.Max(mySheet.Range("t8:ab11"))
        initParams(1) = 65
        initParams(2) = 35
        OneRun
        myrow = j
        mySheet.Cells(myrow, 13).Value = optimParams(1)
        mySheet.Cells(myrow, 14).Value = optimParams(2)
        mySheet.Cells(myrow, 15).Value = optimParams(3)
        mySheet.Cells(myrow, 16).Value = optimParams(4)
        mySheet.Cells(myrow, 17).Value = optimParams(5)
    Next j
End Sub

Private Sub OneRun()
    Dim myinit(4)
    Randomize (Timer)
    optimParams(5) = -1
    For r = 1 To 5
        myinit(1) = initParams(1) + 10 * Rnd() - 5
        myinit(2) = initParams(2) + Rnd() * 10 - 5
        For i = 6 To 13
            mySheet.Cells(5, 19).Value = myinit(1)
            mySheet.Cells(5, 20).Value = myinit(2)
            mySheet.Cells(5, 21).Value = i
            mySheet.Cells(5, 22).Value = maxA
    
            ' Solve the nonlinear equation
            
            solverReset
            SolverOk SetCell:="$W$5", MaxMinVal:=2, ValueOf:="0", ByChange:="$S$5:$V$5"
            SolverAdd CellRef:="$T$5", Relation:=3, FormulaText:="20"
            SolverAdd CellRef:="$S$5", Relation:=1, FormulaText:="80"
            SolverAdd CellRef:="$V$5", Relation:=1, FormulaText:=CStr(maxA)
            SolverSolve UserFinish:=True
            SolverFinish KeepFinal:=1
    
            If optimParams(5) = -1 Then
                   optimParams(1) = mySheet.Cells(5, 19).Value
                   optimParams(2) = mySheet.Cells(5, 20).Value
                   optimParams(3) = mySheet.Cells(5, 21).Value
                   optimParams(4) = mySheet.Cells(5, 22).Value
                   optimParams(5) = mySheet.Cells(5, 23).Value
            ElseIf optimParams(5) > mySheet.Cells(5, 23).Value Then
                   optimParams(1) = mySheet.Cells(5, 19).Value
                   optimParams(2) = mySheet.Cells(5, 20).Value
                   optimParams(3) = mySheet.Cells(5, 21).Value
                   optimParams(4) = mySheet.Cells(5, 22).Value
                   optimParams(5) = mySheet.Cells(5, 23).Value
            End If
        Next i
    Next r
End Sub