有没有办法对Goal Seek施加限制?如果没有,你会怎么做?

时间:2013-06-05 21:27:22

标签: excel vba excel-vba excel-2010

我试图通过改变在F1中找到的De的值来最小化残差平方和的值。我希望CFL Calculated的值尽可能接近CFL Measured的值。这些残差的平方和越小,拟合越好!在询问了stackoverflow的一些建议之后,我决定使用Goal Seek通过改变De的值来最小化残差平方和以尽可能接近零,我希望找到最理想的值。

我让这个程序完美运行,或者我认为......我发现使用=SUM(D2:D14)而不是对每一个残差求和,我不小心使用了=SUM(D2,D14)。所以我只是总结了第一个和最后一个数字。

现在我正在尝试将每个残差平方加起来,我得到了这些疯狂的错误,并且对于De来说是一个疯狂的价值。

我知道De的值必须大于零且小于一。我如何利用这些界限来保持这个目标集中在一定范围内?在这种情况下,De的答案大约为.012,如果有帮助的话。我一直在所有剩余单元格中得到错误#NUM!。这是因为溢出问题吗?

如果你已经得出结论,使用Goal Seek通过找到De的最理想值来最小化这些总和将不起作用,你会怎么做呢?还有其他我可以使用的求解器吗?

以下是代码:

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

3 个答案:

答案 0 :(得分:3)

你得到NUM错误,因为当前解决方案中F1的值为负值 - 并且你试图在你的一个表达式中取F1的平方根。

此外,在这种情况下,目标搜寻对于您正在使用的F1的特定初始启动“猜测”非常敏感。如果您在现在使用的0.1的任一侧稍微改变F1初始值,这将是显而易见的。事实上,目标寻求解决方案存在大的不稳定区域,具体取决于F1值:

Goal Seek Instability

当您提出问题时,如果您可以对解决方案搜索的可能输入设置约束,则更有可能获得可用结果。 Excel附带了一个名为Solver的加载项,允许这样做,并提供了几种不同的搜索方法。首次启动Excel时,解算器不会自动加载,但加载它很容易,如here所述。

答案 1 :(得分:1)

你要求其他解决方案。有关替代方案和一些理论有助于了解正在发生的事情,请查看Numerical Recipes(在线图书here)。第10章处理这个问题。如果您想尝试不同于GoalSeek或Solver加载项的内容,它包含现成的代码示例。当然代码是在Fortran / C / C ++中,但这些代码很容易翻译成VBA(我已经多次这样做了)。

答案 2 :(得分:0)

goalseek函数使用二分法算法,可以这样编码:

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

你在哪里a和b。