VBA程序：二分法求方程的根.docx

VBA程序：二分法求方程的根对于一般超越方程与高次代数方程求根的问题，可选用方法简单实用有效的不求导数的二分法，即在给定的寻根区间内，利用步步查找，二分缩小区间的方法，求出全部实根。二分法求根程序框图见后附件。主要标识符含义：A，B方程求根区间的左、右端点a,bH查根间距、跨步长度hEPS计算精度值，0.00001xA，yA变化过程中的左端点点值及函数值xB，YB变化过程中的右端点点值及函数值xC，yC变化过程中的中点点值及函数值算例已知方程式f(x)=x3-6x2+11x-6=0，求方程的根。给定条件x0.5,3.5，=0.00001，h=0.47。迭代求解后，可得到方程的三个实根：x1=1x2=2x3=3VBA程序代码声明方程求解给定的条件Dim a As Double, b As Double, h As Double, eps As Double声明数组,用来放置根Dim dblRoot() As Double统计根的个数Dim lCount As LongSub Main() Dim Xa As Double, Ya As Double, Xb As Double, Yb As Double 赋初值 a = 0.5 b = 3.5 h = 0.47 eps = 0.00001 Xa = a Xb = a Ya = dblFx(Xa) Xb = Xb + h If Xb b Then Exit Sub Yb = dblFx(Xb) Call Root(Xa, Ya, Xb, Yb) End SubSub Root(Xa1 As Double, Ya1 As Double, Xb1 As Double, Yb1 As Double) If qqqRoot(Ya1, Yb1) Then Call qRoot(Xa1, Ya1, Xb1, Yb1) Else Xa1 = Xb1 Ya1 = Yb1 Xb1 = Xb1 + h If Xb1 b Then Exit Sub Yb1 = dblFx(Xb1) 符合求根条件则求根计算,否则继续调整求根区间 If qqqRoot(Ya1, Yb1) Then Call qRoot(Xa1, Ya1, Xb1, Yb1) Else Call Root(Xa1, Ya1, Xb1, Yb1) End If End IfEnd Sub判断是否符合求根条件Function qqqRoot(dblYa2 As Double, dblYb2 As Double) As Boolean If dblYa2 * dblYb2 eps And Abs(dblXa - dblXb) eps Then dblXc = (dblXa + dblXb) / 2 dblYc = dblFx(dblXc) Call qqRoot(dblXa, dblYa, dblXb, dblYb, dblXc, dblYc) Else 求得一个根 lCount = lCount + 1 dblXd = (dblXa + dblXb) / 2 将所求根保存在数组中 ReDim Preserve dblRoot(1 To lCount) dblRoot(lCount) = dblXd 改变求根区间,以便获取下一个根 dblXa = dblXb dblYa = dblYb dblXb = dblXb + h If dblXb b Then Exit Sub dblYb = dblFx(dblXb) Call Root(dblXa, dblYa, dblXb, dblYb) End IfEnd Sub判断并缩小求根区间Sub qqRoot(dblXa1 As Double, dblYa1 As Double, dblXb1 As Double, dblYb1 As Double, dblXc1 As Double, dblYc1 As Double) If dblYa1 * dblYc1 0 Then dblXa1 = dblXc1 dblYa1 = dblYc1 Else dblXb1 = dblXc1 dblYb1 = dblYc1 End If Call qRoot(dblXa1, dblYa1, dblXb1, dblYb1)End Sub要求根的方程式Function dblFx(dblX As Double) As Double dblFx = dblX * dblX * dblX - 6 * dblX * dblX + 11 * dblX - 6End Function显示根Sub DisplayRoot() Dim i As Long Dim str As String lCount = 0 调用求根程序 Main 遍历并显示所求得的根 For i = LBound(dblRoot) To UBound(dblRoot) str = str & 方程的第 & i & 根是: & dblRoot(i) & Chr(10) Next i MsgBox strEnd Sub参考资料：实用数值计算方法与程序附：二分法求方程的根框图开始送入A,B,h,xA A xB ByA