VBA实现的线性插值算法源代码_怡然

http://blog.sina.com.cn/u/1070342235

首页博文目录关于我

个人资料

微博

加好友发纸条

写留言加关注

博客等级：
博客积分：

博客访问：
关注人气：
获赠金笔：0支
赠出金笔：0支
荣誉徽章：

正文字体大小：大中小

VBA实现的线性插值算法源代码

(2018-05-24 17:44:33)

标签：

excel

vba

代码

分类： VBA专区

水文应用中经常用到插值函数，如水位流量互查、水位库容互查等，而Excel作为一个常用的办公工具，如能在Excel中实现这样的函数是很实用的，这里给出一个VBA实现的线性插值算法代码，具体代码如下：

01.'================================

02.

'
线性插值算法

03.'

04.'

05.'================================

06.

'Returns an interpolated value
of x

07.

'doing a lookup of
xarr->yarr

08.Public Function Interp1(xArr As Variant, _

09. yArr As Variant

,
_

10. x As Double) As Double

11.

12.If

((x <
xArr(LBound(xArr))) _

13. Or (x > xArr(UBound(xArr)))) Then

14. MsgBox "Interp1: x is out of bound"

15. Exit Function

16.End If

17.

18.If xArr(LBound(xArr)) = x Then

19.

Interp1
= yArr(LBound(yArr))

20. Exit Function

21.End If

22.Dim i As Single

23.For

i =
LBound(xArr)

To UBound(xArr)

24. If xArr(i) >= x Then

25.

Interp1
= yArr(i - 1) + (x - xArr(i - 1)) / (xArr(i) - xArr(i - 1)) *
(yArr(i) - yArr(i - 1))

26. Exit Function

27. End If

28.Next i

29.

30.End Function

阅读┊ 收藏 ┊ 喜欢 ▼ ┊打印┊举报/Report

前一篇：VBA自定义函数在水文数据四舍六入中的应用

后一篇：VBA实现多列数据合并为一列

新浪BLOG意见反馈留言板　欢迎批评指正