我正在练习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
答案 0 :(得分:0)
请注意,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
是相反的符号。如果此假设为假,则结果是垃圾,因此某些输入验证(如果需要的话会产生错误)可能是合适的。