Question

我正在练习Excel vba，并尝试通过对分法找到根。我在以下位置创建了用户表单：

textbox1-采用方程式 textbox2-较低点 textbox3-更高的点 textbox4-准确性

和optionButton来选择用于查找根的方法。

我猜所实现的算法是正确的，但结果不正确。我想在处理文本框值时会遇到一些问题

Private Sub CommandButton1_Click()

last = ThisWorkbook.Worksheets("EQ").Cells(Rows.Count,1).End(xlUp).Row

ThisWorkbook.Worksheets("EQ").Cells(last + 1, 1).Value = TextBox1.Text
ThisWorkbook.Worksheets("EQ").Cells(last + 1, 2).Value = TextBox2.Value
ThisWorkbook.Worksheets("EQ").Cells(last + 1, 3).Value = TextBox3.Value
ThisWorkbook.Worksheets("EQ").Cells(last + 1, 4).Value = TextBox4.Value

If OptionButton1.Value = True Then
ThisWorkbook.Worksheets("EQ").Cells(last + 1, 5).Value = "Bisection"


Dim xp As Double
Dim xk As Double
xp = (CDbl(TextBox2.Value))
xk = (CDbl(TextBox3.Value))

ThisWorkbook.Worksheets("EQ").Cells(last + 1, 6).Value = CSng(xm(xp, xk))

End If

(...)

Function xm(xp As Double, xk As Double) As Double

Dim eq as String
Dim fxp As Variant
Dim fxk As Variant
Dim fxm As Variant

xp = (CDbl(TextBox2.Value))
xk = (CDbl(TextBox3.Value))
eq = TextBox1.Text

fxp = (CDbl(Evaluate(Replace(eq, "x", xp))))
fxk = (CDbl(Evaluate(Replace(eq, "x", xk))))
fxm = (CDbl(Evaluate(Replace(eq, "x", xm))))


    Do
        xm = (xp + xk) / 2

        If fxp * fxm < 0 Then
            xk = xm
        Else
            xp = xm
        End If
    Loop Until Abs(xp - xk) < TextBox4.Value

End Function

Answer 1

请注意，fxm = (CDbl(Evaluate(Replace(eq, "x", xm))))在xm被赋予非零值之前。此外，您不会在循环本身中更新f的值。

这是一种方法（使用了大量代码）：

Function bisect(f As String, x As String, xp As Double, xk As Double, eps As Double) As Double
    Dim xm As Double
    Dim fxp As Double, fxk As Double, fxm As Double

    Do
        xm = (xp + xk) / 2
        fxp = (CDbl(Evaluate(Replace(f, x, xp))))
        fxk = (CDbl(Evaluate(Replace(f, x, xk))))
        fxm = (CDbl(Evaluate(Replace(f, x, xm))))

        If fxp * fxm < 0 Then
            xk = xm
        Else
            xp = xm
        End If
    Loop Until Abs(xp - xk) < eps
    bisect = xm
End Function

例如，bisect("1-x-x^3","x",0,1,.0001)的值为0.68231201171875

使自变量成为函数参数的动机是例如如果您想使用使用exp()的函数，则将不得不对自变量执行类似使用t的操作。

您将使用类似以下的方式：

Private Sub CommandButton1_Click()
    Dim eq As String
    Dim xp As Double, xk As Double, eps As Double, root As Double

    eq = TextBox1.Value
    xp = CDbl(TextBox2.Value)
    xk = CDbl(TextBox3.Value)
    eps = CDbl(TextBox4.Value)

    root = bisect(eq, "x", xp, xk, eps)
    MsgBox root
End Sub

代码本身不是很健壮。它只是假设fxp和fxk是相反的符号。如果此假设为假，则结果是垃圾，因此某些输入验证（如果需要的话会产生错误）可能是合适的。

通过二等分法求根

1 个答案: