求助！如何用VBA实现二分法求非线性方程的解~

prettyguoqi

方程为：xln(x/30)=y
X的范围是0<x<1000
在我的附件中，y已经有一系列的值，现在要求对应的x值。
我想用二分法求解，不知道如何编程实现。
谢谢大家！

二分法求根.rar (7.96 KB, 下载次数: 58)

2012-10-8 14:03 上传

点击文件名下载附件

prettyguoqi

自己顶一下{:soso_e149:}

prettyguoqi

{:soso_e164:}没人。。

Moneky

楼主给的0-1000的范围过小，其中绝大多数都无解

1. Function GetV(dbTarget As Double) As Double
   
2.     Dim dbL         As Double
   
3.     Dim dbH         As Double
   
4.     Dim dbM         As Double
   
5.     Dim dbV         As Double
   
6.     Dim dbP         As Double
   
7.     Dim dbSkip      As Double
   
8.     Dim blSkip      As Boolean
   
9.     dbL = 0    'x的下界
   
10.     dbH = 10000000    'x的上界
    
11.     dbP = 0.1    '与目标值的误差
    
12.     dbSkip = 0.000001    '没有结果的判定（当下界与上届的差小于等于此值时，认为在给定范围内无解——此程序用-1表示无解）
    
13.     dbM = (dbH - dbL) / 2    '中点值
    
14.     dbV = dbM * Log(dbM / 30)
    
15.     Do Until Abs(dbV - dbTarget) <= dbP
    
16.         If dbH - dbL <= dbSkip Then    '下界与上界是否接近临界值
    
17.             blSkip = True    '跳出，无解
    
18.             Exit Do
    
19.         End If
    
20.         If dbV > dbTarget Then
    
21.             dbH = dbM
    
22.         Else
    
23.             dbL = dbM
    
24.         End If
    
25.         dbM = dbL + (dbH - dbL) / 2
    
26.         dbV = dbM * Log(dbM / 30)
    
27.         '        Debug.Print dbL, dbH, dbM, dbV, dbTarget
    
28.     Loop
    
29.     GetV = IIf(blSkip, -1, dbM)    '根据blskip判断是否是无解跳出
    
30. End Function
    
31. Sub test()
    
32.     Dim i           As Long
    
33.     For i = 2 To [a1].End(xlDown).Row
    
34.         Cells(i, 2) = GetV(Cells(i, 1))
    
35.     Next
    
36. End Sub
    

复制代码

prettyguoqi

嗯嗯，太感谢了！！
学习了！

wzlyhu

prettyguoqi 发表于 2012-12-23 15:10
嗯嗯，太感谢了！！
学习了！

Function GetV(dbTarget As Double) As Double
    Dim dbL,dbH,dbM,dbV,dbP,dbSkip As Double
    Dim blSkip      As Boolean
    dbL = 0    'x的下界
    dbH = 10000000    'x的上界
    dbP = 0.0001    '与目标值的误差
    dbSkip = 0.000001    '没有结果的判定（当下界与上界的差小于等于此值时，认为在给定范围内无解——此程序用-1表示无解）
    dbM = (dbH - dbL) / 2    '中点值
    dbV = dbM * Log(dbM / 30)    '代数式
    Do Until Abs(dbV - dbTarget) <= dbP
        If dbH - dbL <= dbSkip Then    '下界与上界是否接近临界值
            blSkip = True    '跳出，无解
            Exit Do
        End If
        If dbV > dbTarget Then
            dbH = dbM
        Else
            dbL = dbM
        End If
        dbM = dbL + (dbH - dbL) / 2
        dbV = dbM * Log(dbM / 30)
        '        Debug.Print dbL, dbH, dbM, dbV, dbTarget
    Loop
    GetV = IIf(blSkip, -1, dbM)    '根据blskip判断是否是无解跳出
End Function
Sub test ()
    Dim i           As Long
    For i = 2 To [a1].End(xlDown).Row
        Cells(i, 2) = GetV(Cells(i, 1))
    Next
End Sub