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

VBA程序：二分法求方程的根 VBA程序：二分法求方程的根 PAGE VBA程序：二分法求方程的根 VBA程序：二分法求方程的根 对于一般超越方程与高次代数方程求根的问题，可选用方法简单实用有效的不求导数的二分法，即在给定的寻根区间内，利用步步查找，二分缩小区间的方法，求出全部实根。 二分法求根程序框图见后附件。 主要标识符含义： A，B—方程求根区间的左、右端点[a,b] H—查根间距、跨步长度h EPS—计算精度值，ε＝ xA，yA—变化过程中的左端点点值及函数值 xB，YB—变化过程中的右端点点值及函数值 xC，yC—变化过程中的中点点值及函数值 算例 已知方程式f(x)=x3-6x2+11x-6=0，求方程的根。 给定条件x∈[,]，ε=，h=。 迭代求解后，可得到方程的三个实根： x1=1 x2=2 x3=3 VBA程序代码 声明方程求解给定的条件 Dim a As Double, b As Double, h As Double, eps As Double 声明数组,用来放置根 Dim dblRoot() As Double 统计根的个数 Dim lCount As Long Sub Main() Dim Xa As Double, Ya As Double, Xb As Double, Yb As Double 赋初值 a = b = h = eps = 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 Sub Sub 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 If End Sub 判断是否符合求根条件 Function qqqRoot(dblYa2 As Double, dblYb2 As Double) As Boolean If dblYa2 * dblYb2 = 0 Then qqqRoot = True Else qqqRoot = False End If End Function Sub qRoot(dblXa As Double, dblYa As Double, dblXb As Double, dblYb As Double) Dim dblXc As Double, dblYc As Double, dblXd As Double 是否满足条件,不满足继续缩小求根区间 If Abs(dblYa - dblYb) 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