|
|
'撰写:老朽
'网址:http://Club.ExcelHome.net
'日期:2009-8-20 9:55:29
Public Function LinearInterpolation(ary, x0, Optional Num As Integer = 1)
'VBA入门级作品：表格线性插值,wenguoli3
n = ary.Rows.Count '统计行数
m = ary.Columns.Count '统计列数
If n <= m Then '横表
i = 1
If Num = 2 Then
Do While x0 > ary.Cells(2, i).Value And i < m 'x0位于i-1与i列之间
i = i + 1
Loop
Else
Do While x0 > ary.Cells(1, i).Value And i < m 'x0位于i-1与i列之间
i = i + 1
Loop
End If
If i = 1 Then '超出表格左侧
i = 2
End If
'以下判断要求值的x0是在第一列数据中，还是在第二列数据中：
If Num = 2 Then
k = (x0 - ary.Cells(2, i - 1).Value) / (ary.Cells(2, i).Value - ary.Cells(2, i - 1).Value)
LinearInterpolation = ary.Cells(1, i - 1).Value + k * (ary.Cells(1, i).Value - ary.Cells(1, i - 1).Value)
Else
k = (x0 - ary.Cells(1, i - 1).Value) / (ary.Cells(1, i).Value - ary.Cells(1, i - 1).Value)
LinearInterpolation = ary.Cells(2, i - 1).Value + k * (ary.Cells(2, i).Value - ary.Cells(2, i - 1).Value)
End If
Else '竖表
i = 1
If Num = 2 Then
Do While x0 > ary.Cells(i, 2).Value And i < n 'x0位于i-1与i列之间
i = i + 1
Loop
Else
Do While x0 > ary.Cells(i, 1).Value And i < n 'x0位于i-1与i列之间
i = i + 1
Loop
End If
If i = 1 Then '超出表格顶部
i = 2
End If
'以下判断要求值的x0是在第一列数据中，还是在第二列数据中：
If Num = 2 Then
k = (x0 - ary.Cells(i - 1, 2).Value) / (ary.Cells(i, 2).Value - ary.Cells(i - 1, 2).Value)
LinearInterpolation = ary.Cells(i - 1, 1).Value + k * (ary.Cells(i, 1).Value - ary.Cells(i - 1, 1).Value)
Else
k = (x0 - ary.Cells(i - 1, 1).Value) / (ary.Cells(i, 1).Value - ary.Cells(i - 1, 1).Value)
LinearInterpolation = ary.Cells(i - 1, 2).Value + k * (ary.Cells(i, 2).Value - ary.Cells(i - 1, 2).Value)
End If
End If
End Function
|
|
楼主: zldccmx
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2009-8-20 10:00
楼主
