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

VBA程序：二分法求方程的根对于一般超越方程与高次代数方程求根的问题，可选用方法简单实用有效的不求导数的二分法，即在给定的寻根区间内，利用步步查找，二分缩小区间的方法，求出全部实根。二分法求根程序框图见后附件。主要标识符含义：A，B—方程求根区间的左、右端点[a,b]H—查根间距、跨步长度hEPS—计算精度值，ε＝0.00001xA，yA—变化过程中的左端点点值及函数值xB，YB—变化过程中的右端点点值及函数值xC，yC—变化过程中的中点点值及函数值算例已知方程式f(x)=x3-6x2+11x-6=0，求方程的根。给定条件x∈[0.5,3.5]，ε=0.00001，h=0.47。迭代求解后，可得到方程的三个实根：x1=1x2=2x3=3VBA程序代码'声明方程求解给定的条件DimaAsDouble,bAsDouble,hAsDouble,epsAsDouble'声明数组,用来放置根DimdblRoot()AsDouble'统计根的个数DimlCountAsLongSubMain()DimXaAsDouble,YaAsDouble,XbAsDouble,YbAsDouble'赋初值a=0.5b=3.5h=0.47eps=0.00001Xa=aXb=aYa=dblFx(Xa)Xb=Xb+hIfXbbThenExitSubYb=dblFx(Xb)CallRoot(Xa,Ya,Xb,Yb)EndSubSubRoot(Xa1AsDouble,Ya1AsDouble,Xb1AsDouble,Yb1AsDouble)IfqqqRoot(Ya1,Yb1)ThenCallqRoot(Xa1,Ya1,Xb1,Yb1)ElseXa1=Xb1Ya1=Yb1Xb1=Xb1+hIfXb1bThenExitSubYb1=dblFx(Xb1)'符合求根条件则求根计算,否则继续调整求根区间IfqqqRoot(Ya1,Yb1)ThenCallqRoot(Xa1,Ya1,Xb1,Yb1)ElseCallRoot(Xa1,Ya1,Xb1,Yb1)EndIfEndIfEndSub'判断是否符合求根条件FunctionqqqRoot(dblYa2AsDouble,dblYb2AsDouble)AsBooleanIfdblYa2*dblYb2=0ThenqqqRoot=TrueElseqqqRoot=FalseEndIfEndFunctionSubqRoot(dblXaAsDouble,dblYaAsDouble,dblXbAsDouble,dblYbAsDouble)DimdblXcAsDouble,dblYcAsDouble,dblXdAsDouble'是否满足条件,不满足继续缩小求根区间IfAbs(dblYa-dblYb)epsAndAbs(dblXa-dblXb)epsThendblXc=(dblXa+dblXb)/2dblYc=dblFx(dblXc)CallqqRoot(dblXa,dblYa,dblXb,dblYb,dblXc,dblYc)Else'求得一个根lCount=lCount+1dblXd=(dblXa+dblXb)/2'将所求根保存在数组中ReDimPreservedblRoot(1TolCount)dblRoot(lCount)=dblXd'改变求根区间,以便获取下一个根dblXa=dblXbdblYa=dblYbdblXb=dblXb+hIfdblXbbThenExitSubdblYb=dblFx(dblXb)CallRoot(dblXa,dblYa,dblXb,dblYb)EndIfEndSub'判断并缩小求根区间SubqqRoot(dblXa1AsDouble,dblYa1AsDouble,dblXb1AsDouble,dblYb1AsDouble,dblXc1AsDouble,dblYc1AsDouble)IfdblYa1*dblYc10ThendblXa1=dblXc1dblYa1=dblYc1ElsedblXb1=dblXc1dblYb1=dblYc1EndIfCallqRoot(dblXa1,dblYa1,dblXb1,dblYb1)EndSub'要求根的方程式FunctiondblFx(dblXAsDouble)AsDoubledblFx=dblX*dblX*dblX-6*dblX*dblX+11*dblX-6EndFunction'显示根SubDisplayRoot()DimiAsLongDimstrAsStringlCount=0'调用求根程序Main'遍历并显示所求得的根Fori=LBound(dblRoot)ToUBound(dblRoot)str=str&方程的第&i&根是:&dblRoot(i)&Chr(10)NextiMsgBoxstrEndSub参考资料：实用数值计算方法与程序附：二分法求方程的根框图送入A,B,h,εxAAxBByAf(xA)xBxB+hxBByBf(xB)yA·yB0|yA-yB|ε或|xA-xB|εyCf(xC)xC(xA+xB)/2xAxCyAyCxBxCyByCyA·yC0xAxByAyB打印xA,xB开始结束TFTTT