0

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

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

现在我试图对每个残差求和，我得到了这些疯狂的错误，以及一个疯狂的 De 值。

我知道 De 的值必须大于零且小于一。我如何使用这些界限将这个目标寻求集中在一定范围内？在这种情况下，De 的答案约为 0.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
4

3 回答 3

3

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

此外，在这种情况下，目标搜索对您正在使用的 F1 的特定初始起始“猜测”非常敏感。如果您在现在使用的 0.1 的任一侧稍微改变 F1 初始值，这一点就会很明显。事实上，根据 F1 值，目标寻求解决方案存在很大的不稳定区域：

目标寻求不稳定性

正如您在问题中提出的那样，如果您可以对解决方案搜索的可能输入设置限制，您更有可能获得可用的结果。Excel 附带一个称为Solver允许这样做的加载项，并提供了几种不同的搜索方法。首次启动 Excel 时，求解器不会自动加载，但加载它很容易，如此处所述。

于 2013-06-06T14:42:22.277 回答
1

您要求其他求解器。对于替代方案和一些理论来帮助理解正在发生的事情，请查看数字食谱（此处的在线书籍）。第 10 章讨论了这个问题。GoalSeek如果您想尝试与 Solver 插件不同的东西，它包括现成的代码示例。当然，代码是用 Fortran/C/C++ 编写的，但这些代码很容易翻译成 VBA（我已经做过很多次了）。

于 2013-06-06T06:43:33.293 回答
0

目标函数使用二分法算法，可以这样编码：

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 是你的界限。

于 2015-01-21T09:29:26.090 回答