EXCEL VBA求一元二次方程式 (不用公式解)(2)
- 帖子
- 2025
- 主題
- 13
- 精華
- 0
- 積分
- 2053
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- Office2007
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台北市
- 註冊時間
- 2011-3-2
- 最後登錄
- 2024-3-14
     
|
本帖最後由 ML089 於 2021-10-26 08:40 編輯
回復 9# Andy2483
星期日去露營，星期一晚上回家，看到你的程式解一元四次，套到我原先的程式沒有辦法完成解出，不完善地方很多。
本來露營回來很累應要早睡的卻又睡不著，重新修正一下原先程式，終於完成可以睡覺了。
1 大區間 -10000 ~ 10000 查詢要快，將 查詢 Step 分為 大、中、小(可變) ，初始 s = 100，遇到第一解後 改為 s = s1 = 0.1，當解在區間(x ~ x+s)時再細分 s/ss，ss=10都可以。加速查詢
解答完4次解就可以跳離迴圈，加速查詢
這次優化計算迴圈由 20800次降至 500次左右
2 有近似解時，再以f( round(x,12) )檢查修正為真實解。
3 還缺少你的友善人機介面，這星期再來想一想。
Function f(x)
'f = x ^ 2 + 2 * x - 4
'f = x ^ 4 - 6 * x ^ 3 + x ^ 2 + 2 * x + 24
f = 2 * x ^ 4 - 4 * x ^ 3 - 3 * x ^ 2 + 7 * x - 2 '人工填入方程式
End Function
Sub 一元方程式暴力解法_ML089()
Dim r, c1, c2, n, x, x2, s, s1, ss, ct, tm, xNo, xN
tm = Timer
ThisWorkbook.Sheets.Add(After:=Worksheets(1)).Name = Format(Now(), "dd_hhmmss") '
x1 = -10000: x2 = 10000: x = x1 '查詢區間
s = 100: s1 = 0.1: ss = 10: 'Step 初始值使用s,找解1區間後使用s1，ss區間細分除數
xNo = 4: xN = 0 '一元幾次 : 計次
r = 3: c1 = 1: c2 = 2 'cells 位置
'Cells(r, c1).Resize(, 3) = Array("x1", "x2", "f(x1)")
While x <= x2
'DoEvents '會增加計算時間
ct = ct + 1 '循環次數
If Application.Median(f(x), 0, f(x + s)) = 0 Then '解答是否在x與x+s之間
'r = r + 1: Cells(r, c1).Resize(, 3) = Array(x, x + s, f(x)) 'Debug 用
If Round(f(x), 12) = 0 Then '精度小數12位數為0時為近似解
xN = xN + 1: r = r + 1
ANS = "近似解：X" & xN & " = "
If f(Round(x, 12)) = 0 Then '真實解判斷與修正
x = Round(x, 12)
ANS = "真實解：X" & xN & " = "
End If
Cells(r, c1) = ANS & x & " ,f(x) = " & f(x)
If xN = xNo Then GoTo 999 '解答完成跳出迴圈
x = x + s
s = s1
Else
s = s / ss '目前x~x+s區間，s再細分1/SS倍
End If
Else
x = x + s
End If
Wend
999:
Cells(r + 1, c1) = "查詢區間：" & x1 & " " & x2
Cells(r + 2, c1) = "Step 初始值及細分除數：" & s1 & " " & ss
Cells(r + 3, c1) = "循環次數：" & ct
Cells(r + 4, c1) = "計算時間：" & Format(Timer - tm, "0.000")
End Sub
'可以刪除日測試工作表
Sub Del_Sheet()
Dim MyBook As Workbook, sh As Worksheet
Set MyBook = ThisWorkbook
Application.DisplayAlerts = False '停止系統的警示
For Each sh In MyBook.Sheets
If sh.Name Like Day(Now()) & "_*" Then sh.Delete '刪除當日 DD_*
Next
Application.DisplayAlerts = True '恢復系統的警示
End Sub |
|
|
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式
|
|
|
|
|
- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-11-28
|
12#
發表於 2022-9-28 22:01
| 只看該作者
回復 11# ML089
前輩教師節快樂
向您道歉 sorry：
10樓之後忙新的案件，好長一段時間沒上論壇學習，前幾天學習Function ()才看到11樓的前輩指導回覆，心裏一直過意不去，趁今天教師節向前輩回覆，並祝前輩 教師節快樂 |
|
|
|
|
|
|
|
發表於 2021-10-26 00:21
| 