vba 有没有办法限制目标搜索？如果没有，你会怎么做？

Is there a way to put bounds on Goal Seek? If not, how would you go about this?

提问by TheTreeMan

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.

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

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.

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

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

现在我正在尝试将每个残差平方相加，我得到了这些疯狂的错误，以及 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?

我知道 De 的值必须大于零且小于一。我怎样才能使用这些界限来使这个目标寻求集中在一定范围内？在这种情况下，De 的答案大约是 0.012，如果这有帮助的话。我不断收到#NUM!所有剩余单元格的错误。这是因为溢出问题吗？

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?

如果您已经得出结论，使用 Goal Seek 通过找到 De 的最理想值来最小化这些总和是行不通的，那么您会怎么做？我可以使用其他任何求解器吗？

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) / $H) * SQRT(($F * 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

回答by chuff

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.

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

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:

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

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 Solverthat 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.

正如您在问题中提出的那样，如果您可以对解决方案搜索的可能输入设置约束，则更有可能获得可用的结果。Excel 附带一个名为的加载项Solver，允许这样做，并提供几种不同的搜索方法。求解当你第一次启动Excel时自动加载，但加载它是容易的，说明这里。

回答by Jean-Fran?ois Corbett

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 GoalSeekor 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).

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

回答by user3320141

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

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

Where a and b are you bounds.

你在哪里 a 和 b 是界限。