- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
3#
發表於 2021-10-20 16:45
| 只看該作者
更正:拋物線開口朝上
Option Explicit
Sub TEST()
Cells.Interior.ColorIndex = xlNone
Dim X, Y, a, b, c, n, U1, U2, u, v, S, S0, S1, Y0, Y1, X1, X2, P, J, B2_4AC
J = 1
Y = a * X ^ n + b * X + c: a = 1: b = 2: c = -4: n = 2
B2_4AC = b ^ 2 - 4 * a * c
If n = 2 Then
If (4 * a * c - b ^ 2) / 4 * a = 0 Then
MsgBox "唯一解 X= " & (-b) / (2 * a): Exit Sub
ElseIf ((4 * a * c - b ^ 2) / 4 * a > 0 And a > 0) Or ((4 * a * c - b ^ 2) / 4 * a < 0 And a < 0) Then
MsgBox " X 無解!": Exit Sub
End If
If b = 0 And c < 0 Then X1 = (-c / a) ^ 0.5: X2 = -(-c / a) ^ 0.5
If a > 0 Then MsgBox "拋物線開口向上" Else: MsgBox "拋物線開口向下"
End If
U1 = Round((-b - B2_4AC ^ 0.5) / (2 * a), 2)
U2 = Round((-b + B2_4AC ^ 0.5) / (2 * a), 2)
u = (Abs(U1) + 1) * 110: v = (Abs(c) + 1) * 110
Columns(u).Interior.ColorIndex = 1
Rows(v).Interior.ColorIndex = 1
Cells(v, u - Abs(U1) * 100).Interior.ColorIndex = 3
Cells(v, Abs(U2) * 100 + u).Interior.ColorIndex = 3
For X = U1 - 0.2 To U2 + 0.2 Step 0.01
Y = Round(a * X ^ 2 + b * X + c, 2)
Cells(v - Y * 100, X * 100 + u).Interior.ColorIndex = 3
Next
888: S0 = -100 * J: S1 = 100 * J: S = J: P = 1
999
For X = S0 To S1 Step S
Y0 = a * X ^ n + b * X + c
Y1 = (a * (X + S)) ^ n + (b * (X + S)) + c
P = Y0 * Y1
If (S < 10 ^ -13 And J = 1) Or (S > -(10 ^ -13) And J = -1) Then P = 0
If P = 0 Then
If c = 0 And J = 1 Then MsgBox "X1= " & X
If c = 0 And J = -1 Then MsgBox "X2= " & X
If J = -1 Then: MsgBox "X1= " & X1 & vbLf & vbLf & "X2= " & X2: Exit Sub
J = -1: GoTo 888
ElseIf P < 0 Then
S0 = X: S1 = S0 + S: S = S / 10 '
If J = 1 Then
MsgBox "X1 介於 " & S0 & " ~ " & S1
X1 = S1
Else
MsgBox "X2 介於 " & S0 & " ~ " & S1
X2 = S1
End If
GoTo 999
End If
Next
End Sub |
|
