有没有办法限制“寻求目标”？ 如果没有，您将如何处理？

Question

I'm trying to minimize the value of the sum of the residuals squared by varying the value of De, which is found in F1. I want the values of CFL Calculated to be as close as possible to the values of CFL Measured. The smaller the sum of those residuals squared, the better the fit! After asking stackoverflow for some advice, I decided to use Goal Seek to minimize the sum of the residuals squared to get as close to zero as possible by varying the value of De, which I want to find the most ideal value of.

I got this program to run perfectly, or so I thought... I found out that instead of summing every single residuals using =SUM(D2:D14) , I accidentally used =SUM(D2,D14) . So I was only summing up the first and last numbers.

Now that I'm trying to sum every residual squared up, I'm getting these crazy errors, and an insane value for De.

I know that the value of De has to be greater than zero, and less than one. how can I use these bounds to keep this goal seek focused within a certain range? The answer for De in this case is about .012, if that helps. I keep getting the error #NUM! in all of the residual cells. Is this because of overflow issues?

If you've concluded that using Goal Seek to minimize these sums by finding the most ideal value of De will not work, how would you go about it? Are there any other solvers I could use?

Here is the code:

Option Explicit

Dim Counter As Long
Dim DeSimpleFinal As Double
Dim simpletime As Variant
Dim Tracker As Double
Dim StepAmount As Double
Dim Volume As Double
Dim SurfArea As Double
Dim pi As Double
Dim FinalTime As Variant
Dim i As Variant

Sub SimpleDeCalculationNEW()

    'This is so you can have the data and the table I'm working with!
    Counter = 13
    Volume = 12.271846
    SurfArea = 19.634954
    pi = 4 * Atn(1)
    Range("A1") = "Time(days)"
    Range("B1") = "CFL(measured)"
    Range("A2").Value = 0.083
    Range("A3").Value = 0.292
    Range("A4").Value = 1
    Range("A5").Value = 2
    Range("A6").Value = 3
    Range("A7").Value = 4
    Range("A8").Value = 5
    Range("A9").Value = 6
    Range("A10").Value = 7
    Range("A11").Value = 8
    Range("A12").Value = 9
    Range("A13").Value = 10
    Range("A14").Value = 11
    Range("B2").Value = 0.0612
    Range("B3").Value = 0.119
    Range("B4").Value = 0.223
    Range("B5").Value = 0.306
    Range("B6").Value = 0.361
    Range("B7").Value = 0.401
    Range("B8").Value = 0.435
    Range("B9").Value = 0.459
    Range("B10").Value = 0.484
    Range("B11").Value = 0.505
    Range("B12").Value = 0.523
    Range("B13").Value = 0.539
    Range("B14").Value = 0.554

    Range("H2").Value = Volume
    Range("H1").Value = SurfArea

    Range("C1") = "CFL Calculated"
    Range("D1") = "Residual Squared"
    Range("E1") = "De value"
    Range("F1").Value = 0.1

    'Inserting Equations
    Range("C2") = "=((2 * $H$1) / $H$2) * SQRT(($F$1 * A2) / PI())"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C" & Counter + 1), Type:=xlFillDefault

    Range("D2") = "=((ABS(B2-C2))^2)"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D" & Counter + 1), Type:=xlFillDefault

    'Summing up the residuals squared
    Range("D" & Counter + 2) = "=Sum(D2: D" & Counter + 1 & ")"

    'Goal Seek
    Range("D" & Counter + 2).GoalSeek Goal:=0, ChangingCell:=Range("F1")

    Columns("A:Z").EntireColumn.EntireColumn.AutoFit

    DeSimpleFinal = Range("F1")    
    MsgBox ("The Final Value for DeSimple is: " & DeSimpleFinal)

End Sub

Answer 1

You're getting NUM errors because the value of F1 is going negative in your current solution -- and you are trying to take the square root of F1 in one of your expressions.

Also, goal seek is, in this instance, incredibly sensitive to the particular initial starting "guess" for F1 that you are using. This will be evident if you vary the F1 initial value by a little bit on either side of the 0.1 you are using now. There are, in fact, large regions of instability in the goal seek solution, depending on the F1 value:

As you brought up in your question, you are more likely to get a useable result if you can set constraints on the possible inputs to your solution search. Excel comes with an add-in called Solver that allows that, as well as offers several different search methods. Solver is not loaded automatically when you first start Excel, but loading it is easy, as explained here .

Answer 2

You ask for other solvers. For alternatives and a bit of theory to help understand what's going on, have a look at Numerical Recipes (online books here ). Chapter 10 deals with this. It includes ready-made code samples if you want to try something different than GoalSeek or the Solver add-in. Of course the code is in Fortran/C/C++ but these are readily translated into VBA (I've done this many times).

Answer 3

The goalseek function uses a dichotomy algorithm which can be coded like this:

Sub dicho(ByRef target As Range, ByRef modif As Range, ByVal targetvalue As Double, ByVal a As Double, ByVal b As Double)

Dim i As Integer
Dim imax As Integer
Dim eps As Double

eps = 0.01
imax = 10
i = 0
While Abs(target.Value - targetvalue) / Abs(targetvalue) > eps And i < imax

    modif.Value = (a + b) / 2
    If target.Value - targetvalue > 0 Then
        a = (a + b) / 2
    Else
        b = (a + b) / 2
    End If
    i = i + 1
Wend
End Sub

Where a and b are you bounds.