求在excel vba 编一个通用的二分法求根函数

yhh8799 · 发表于 2010-6-17 16:40

dsmch · 发表于 2010-6-17 16:53

太笼统了，请上传附件，方便大家帮你。

yhh8799 · 发表于 2010-6-17 17:39

Public Function 二分法(ByVal Z上, ByVal 出力, ByVal Q1, ByVal Q2, ByVal Dimension)
Dim N As Integer
  If F(Q1, Z上, 出力) * F(Q2, Z上, 出力) > 0 Then
   MsgBox "区间[" & Q1 & "," & Q2 & "]之间没有根，请重新输入！"
  End If
  N = 0
  Do
   二分法 = (Q1 + Q2) / 2
   If F(二分法, Z上, 出力) * F(Q1, Z上, 出力) > 0 Then
   Q1 = 二分法
   Else
   Q2 = 二分法
   End If
   N = N + 1
   If N > 200 Then
   Exit Do
   End If
  Loop Until Abs(Q1 - Q2) <= Dimension
End Function

Function F(ByVal Q, ByVal Z上, ByVal 出力) As Double  '函数
Dim detaH As Double
  detaH = Z上 - 插值(Range("水位流量关系Q"), Range("水位流量关系Z下"), Q)
  F = 8.3 * Q * detaH - 出力 * 1000
End Function

这是我写的二分法，但是这样我的二分法函数不具有通用性，如果在主程序里面对几个F进行求解，如何写就函数名也可以在二分法里面传递

ljw990485 · 发表于 2010-6-17 19:58

我的理解是你想实现一个通用的二分法函数
比如 function Method(f as ???,a as double,b as double) as double
其中f为一个函数参数，a为初始左端点，b为初始右端点，输出为函数零点

但由于VB/VBA没有函数指针，函数不能作为一个参数来调用另外一个过程或函数，所以直接实现你的功能是不可能的
但可以通过大量使用API的方法（这个网上有），或者自己使用C++编写一个组件的方法（内部使用函数指针），间接实现你想要的功能

ljw990485 · 发表于 2010-6-17 20:48

实在不了解LZ的
ByVal Z上, ByVal 出力两个变量有什么用

ljw990485 · 发表于 2010-6-17 22:04

做了一个通用的二分法，应该满足LZ的要求，至于LZ的 “Z上”和“ 出力”两个变量，变通一下就可以了

第一个附件少了一条语句

[ 本帖最后由 ljw990485 于 2010-6-17 22:23 编辑 ]

northwolves · 发表于 2010-6-17 22:18

这样？

Sub BinarySearch(ByVal Expression As String, ByVal Q1 As Double, ByVal Q2 As Double, Optional ByRef root As Double, Optional ByVal Precision As Double = 0.0000000001)
Dim n As Long, msg As String
msg = "方程 " & Expression & " 在区间[" & Q1 & "," & Q2 & "]"
Expression = Replace(Expression, "=", "-")
If Evaluate(Replace(Expression, "x", Q1)) * Evaluate(Replace(Expression, "x", Q2)) > 0 Then
MsgBox msg & "之间没有根，请重新输入！"
Exit Sub
End If
n = 0
Do
root = (Q1 + Q2) / 2
If Evaluate(Replace(Expression, "x", root)) * Evaluate(Replace(Expression, "x", Q1)) > 0 Then
Q1 = root
Else
Q2 = root
End If
n = n + 1
If n > 200 Then Exit Do
Loop Until Abs(Q1 - Q2) <= Precision
MsgBox msg & "找到一个根：" & root
End Sub
Sub solve()
BinarySearch "x^2=3", 1, 2
End Sub

复制代码

ljw990485 · 发表于 2010-6-17 22:27

LS太过于自信了吧

1）Replace(Expression, "=", "-") 会出问题的！

应该是 Replace(Expression, "=", "-(") & ")"

2）Replace(Expression, "x", Q1)等均可能会出问题的，为什么？想想就知道了，Q1是负数就可能出问题
正确的应该写为
Replace(Expression, "x", “(" & Q1 & ")" )

3) LS方法对于分段函数，就会失效！尤其是多段函数
不要把iif拿来哦,

[ 本帖最后由 ljw990485 于 2010-6-17 22:46 编辑 ]

northwolves · 发表于 2010-6-18 06:58

原帖由 ljw990485 于 2010-6-17 22:27 发表
LS太过于自信了吧

1）Replace(Expression, "=", "-") 会出问题的！

应该是 Replace(Expression, "=", "-(") & ")"

2）Replace(Expression, "x", Q1)等均可能会出问题的，为什么？想想就知道了，Q1是负数就 ...

多谢指教，考虑不周，学习了。

yhh8799 · 发表于 2010-6-19 18:25

正如ljw990485 所说，我就是想实现函数能作为参数进行传递和调用，fotran里面可以实现，但vba里面就不行。

至于ljw990485 所说可以通过大量使用API的方法（这个网上有），或者自己使用C++编写一个组件的方法（内部使用函数指针）。能否帮忙查找和提供些，谢谢

		自动登录	找回密码
密码			免费注册

求在excel vba 编一个通用的二分法求根函数

回复 4楼 ljw990485 的帖子