线性内插值自定义函数-求大师优化

YZC51

线性内插值自定义函数-求大师优化

学习czzqb版主《线性内插值应用实例》 的帖子，受益颇丰！
特献上学习心得“线性内插值自定义函数”，水平所限，错误难免，还请各位大师斧正!
原帖地址:http://club.excelhome.net/thread-188522-1-1.html

Function Pola(sr, n, o) '插值函数
    If Application.IsNumber(n) Then n = Chr(64 + n)
    If Application.IsNumber(o) Then o = Chr(64 + o)
    l = Range(n & 65536).End(3).Row
    m = Range(n & l)
    If sr > m Then Pola = "溢出": Exit Function
    If sr = m Then Pola = Range(o & l) & "": Exit Function
    i = Application.Match(sr, Range(n & ":" & n), 1)
    Set rn1 = ActiveSheet.Range(o & i & ":" & o & i + 1)
    Set rn2 = ActiveSheet.Range(n & i & ":" & n & i + 1)
    Pola = Application.Trend(rn1, rn2, sr, 1)
End Function

YZC51

函数2

1. Function Pola2(sr) '插值函数
   
2.     n = [a1:z1].Find("X", , , , 1).Column
   
3.     n = Chr(64 + n)
   
4.     o = [a1:z1].Find("Y", , , , 1).Column
   
5.     o = Chr(64 + o)
   
6.     l = Range(n & 65536).End(3).Row
   
7.     m = Range(n & l)
   
8.     If sr > m Then Pola2 = "溢出": Exit Function
   
9.     If sr = m Then Pola2 = Range(o & l) & "": Exit Function
   
10.     i = Application.Match(sr, Range(n & ":" & n), 1)
    
11.     Set rn1 = ActiveSheet.Range(o & i & ":" & o & i + 1)
    
12.     Set rn2 = ActiveSheet.Range(n & i & ":" & n & i + 1)
    
13.     Pola2 = Application.Trend(rn1, rn2, sr, 1)
    
14. End Function

复制代码

YZC51

附件
一维内插值（函数）.rar (9.47 KB, 下载次数: 124)

2016-2-21 16:07 上传

点击文件名下载附件

YZC51

函数3

1. Function Pola1(sr, n, o) '插值函数****纯数学公式
   
2.     If Application.IsNumber(n) Then n = Chr(64 + n)
   
3.     If Application.IsNumber(o) Then o = Chr(64 + o)
   
4.     l = Range(n & 65536).End(3).Row
   
5.     i = Application.Match(sr, Range(n & ":" & n), 1)
   
6.     A = Range(o & i)
   
7.     B = Range(o & i + 1)
   
8.     c = Range(n & i)
   
9.     D = Range(n & i + 1)
   
10.     Pola1 = (B - A) * (sr - c) / (D - c) + A
    
11. End Function
    

复制代码

YZC51

函数4
再次优化

1. Function Pola3(sr, n, o) '插值函数****纯数学公式
   
2.     P = Chr(64 + n)
   
3.     i = Application.Match(sr, Range(P & ":" & P))
   
4.     A = Cells(i, o)
   
5.     B = Cells(i + 1, o)
   
6.     c = Cells(i, n)
   
7.     D = Cells(i + 1, n)
   
8.     Pola3 = (B - A) * (sr - c) / (D - c) + A
   
9. End Function
   

复制代码

YZC51

二维插值自定义函数

1. Function TPola(x, y, r As Range) '¶þά
   
2. xw = Application.Match(x, Application.Index(r, 1, 0), 1)
   
3. yw = Application.Match(y, Application.Index(r, 0, 1), 1)
   
4. x1 = r(1, xw)
   
5. X2 = r(1, xw + 1)
   
6. Y1 = r(yw, 1)
   
7. Y2 = r(yw + 1, 1)
   
8. q11 = r(yw, xw)
   
9. q12 = r(yw + 1, xw)
   
10. q21 = r(yw, xw + 1)
    
11. q22 = r(yw + 1, xw + 1)
    
12. YY1 = (y - Y1) / (Y2 - Y1) * (q12 - q11) + q11
    
13. YY2 = (y - Y1) / (Y2 - Y1) * (q22 - q21) + q21
    
14. TPola = (x - x1) / (X2 - x1) * (YY2 - YY1) + YY1
    
15. End Function
    

复制代码

YZC51

使用说明：
本函数有3个参数：
X,为X1行中的任意数值
Y,为Y1列中的任意数值
Z,为数据表区域
例如：
为X1列中的任意数值
=TPola(K2,L2,A1:I13)

13782671637

YZC51 发表于 2016-2-25 14:25
使用说明：
本函数有3个参数：
X,为X1行中的任意数值

老师：您写的自定义函数很好！但平时使用自定义函数的，大都是excel函数公式转过来的人【和我一样】，对VBA知之甚少。最好自定义函数代码后面随附一个附件，里面要有输入语法和实例详解。这样一目了然，能够吸引更多的参与者。

/fw虫虫/zq

牛牛牛牛牛牛牛

onthetrip

这个用内置函数TREND就行吧？