|
楼主 |
发表于 2009-5-19 11:03
|
显示全部楼层
感谢朋友们的关注,欢迎提出批评指正意见!
有朋友问起如何求解多个一元三次方程,其实略加改造,做成自定义函数,就方便使用了。
aX3+bX2+cX+d=0,(a,b,c,d∈R,且a≠0)
如:2X3+3X2+4X+5=0
=ShengJin(2,3,4,5,0) '返回值:一个实根+一对共轭虚根
=ShengJin(2,3,4,5,1) '返回值:-1.371134331
=ShengJin(2,3,4,5,2) '返回值:-6.44328343463185E-02+1.34876101196125i
=ShengJin(2,3,4,5,3) '返回值:-6.44328343463185E-02-1.34876101196125i
=ShengJin(2,3,4,5,5) '返回值:#VALUE!
'========以下为代码部分==========
- Option Explicit
- Function ShengJin(a, b, c, d, v)
- On Error Resume Next
- Dim e, f, g, h, x1, x2, x3, s$
- e = b ^ 2 - 3 * a * c 'A
- f = b * c - 9 * a * d 'B
- g = c ^ 2 - 3 * b * d 'C
- h = f ^ 2 - 4 * e * g 'Δ
- If Round(e, 8) = 0 And Round(f, 8) = 0 Then '盛金公式①
- x1 = -b / (3 * a)
- x2 = -c / b
- x3 = -3 * d / c
- s = "三重实根"
- Else
- Select Case Round(h, 10)
- Case Is > 0 '盛金公式②
- Dim x, y
- x = e * b + 3 * a * (-f + Abs(h) ^ 0.5 * Sgn(h)) / 2
- y = e * b + 3 * a * (-f - Abs(h) ^ 0.5 * Sgn(h)) / 2
- x1 = (-b - Abs(x) ^ (1 / 3) * Sgn(x) - Abs(y) ^ (1 / 3) * Sgn(y)) / (3 * a)
- x2 = (-2 * b + Abs(x) ^ (1 / 3) * Sgn(x) + Abs(y) ^ (1 / 3) * Sgn(y)) / (6 * a) & "+" & 3 ^ 0.5 * (Abs(x) ^ (1 / 3) * Sgn(x) - Abs(y) ^ (1 / 3) * Sgn(y)) / (6 * a) & "i"
- x3 = (-2 * b + Abs(x) ^ (1 / 3) * Sgn(x) + Abs(y) ^ (1 / 3) * Sgn(y)) / (6 * a) & "-" & 3 ^ 0.5 * (Abs(x) ^ (1 / 3) * Sgn(x) - Abs(y) ^ (1 / 3) * Sgn(y)) / (6 * a) & "i"
- s = "一个实根+一对共轭虚根"
- Case Is = 0 '盛金公式③
- x1 = -b / a + f / e
- x2 = -f / e / 2
- x3 = -f / e / 2
- s = "三个实根中含一个两重根"
- Case Else '盛金公式④
- Dim tmp3 As Double
- tmp3 = Application.Acos((2 * e * b - 3 * a * f) / (2 * (Abs(e) ^ (3 / 2) * Sgn(e)))) / 3
- x1 = (-b - 2 * Abs(e) ^ 0.5 * Sgn(e) * Cos(tmp3)) / (3 * a)
- x2 = (-b + Abs(e) ^ 0.5 * Sgn(e) * (Cos(tmp3) + 3 ^ 0.5 * Sin(tmp3))) / (3 * a)
- x3 = (-b + Abs(e) ^ 0.5 * Sgn(e) * (Cos(tmp3) - 3 ^ 0.5 * Sin(tmp3))) / (3 * a)
- s = "三个不相等的实根"
- End Select
- End If
- Select Case v '定义函数输出值
- Case 0
- ShengJin = s 'v=0,方程解的描述
- Case 1
- ShengJin = x1 'v=1,第一个解
- Case 2
- ShengJin = x2 'v=2,第二个解
- Case 3
- ShengJin = x3 'v=3,第三个解
- Case Else
- ShengJin = "#VALUE!" '无法识别的,显示错误值
- End Select
- End Function
复制代码
[ 本帖最后由 sunya_0529 于 2009-5-19 11:07 编辑 ] |
|