学习Excel技术,关注微信公众号:
excelperfect
在上篇文章中,我们展示了自定义函数有效的方式是通过将单元格区域读取到Variant型数组来传递单元格区域数据。本文将介绍在自定义函数中最有效的方式是使用Excel内置函数。
线性插值是一种常用技术,用来查找缺失值或者计算两个值之间的值。例如下表:
图1
现在,想要知道Level的66.25对应的Flow1的值是多少?假设该值在66的Level对应的Flow1值6.19与66.5的Level对应的Flow1值8.64构成的直线上,可以计算66.25对应的Flow1的值如下:
8.64与6.19之差是2.45,66.25是66与66.5之间的中间值,所以将2.45的一半加上6.19得到7.415。
公式为:
=6.19+(8.64-6.19)*(66.25-66.0)/(66.5-66.0)
编写一个简单的自定义函数如下:
Function VINTERPOLATEA(Lookup_ValueAs Variant, _
Table_Array As Range, _
Col_Num As Long)
Dim vArr As Variant
Dim j As Long
vArr = Table_Array.Value2
For j = 1 To UBound(vArr)
If vArr(j, 1) > Lookup_Value Then
Exit For
End If
Next j
VINTERPOLATEA = (vArr(j - 1, Col_Num) + _
(vArr(j, Col_Num) - vArr(j - 1, Col_Num)) * _
(Lookup_Value - vArr(j - 1, 1)) / (vArr(j, 1) - vArr(j - 1, 1)))
End Function
代码中,Lookup_value是在单元格区域Table_Array的第1列中要找的值,Col_Num是要进行插值的数据的列号索引(本例中为2)。
这个自定义函数计算速度已经很快了。然而,还可以更快!
仔细分析这个自定义函数代码,实际的计算仅使用2行数据,但要获得这2行数据必须将所有数据导入到数组并在第1列执行线性查找。
因此,让我们试着在自定义函数代码中通过Application.WorksheetFunction.MATCH来使用Excel的MATCH函数。由于数据已排序,所以可以使用近似匹配查找MATCH。一旦通过MATCH获取行号,就可以获得我们需要的数据所在的2行。
修改后的自定义函数如下:
Function VINTERPOLATEB(Lookup_Value As Variant, _
Table_Array As Range, _
Col_Num As Long)
Dim jRow As Long
Dim rng As Range
Dim vArr As Variant
Set rng = Table_Array.Columns(1)
jRow = Application.WorksheetFunction.Match(Lookup_Value, rng, 1)
vArr = Table_Array.Resize(2).Offset(jRow - 1, 0).Value
VINTERPOLATEB = (vArr(1, Col_Num) + _
(vArr(2, Col_Num) - vArr(1, Col_Num)) * _
(Lookup_Value - vArr(1, 1)) / (vArr(2, 1) - vArr(1, 1)))
End Function
代码使用MATCH函数查找到所需的行,然后使用Resize和Offset将区域调整为仅需要的2行数据。
注意,有两种方法从VBA调用像MATCH这样的Excel函数:Application.Match和Application.WorksheetFunction.Match。其差别主要在于错误处理(例如,当在完全匹配选项时找不到完全匹配项):
Application.Match返回包含错误的Variant型值,允许使用IsError:
If IsError(Application.Match)
Application.WorksheetFunction.Match触发VBA错误,需要On Error语句处理。
并且Application.Math更快些。
因此,需要添加错误处理和达到数据边界的情况处理:
使用On Error来捕捉非数字数据
检查要查找的值是否在表中数据范围之外
检查要查找的值是否是表中最后一个值
代码如下:
Function VINTERPOLATEC(Lookup_ValueAs Variant, _
Table_Array As Range, _
Col_Num As Long)
Dim jRow As Long
Dim rng As Range
Dim vArr As Variant
Dim vValue As Variant
On Error GoTo FuncFail
Set rng = Table_Array.Columns(1)
'检查是否是最后一行
vValue = rng.Cells(rng.Rows.Count, 1).Value2
If Lookup_Value = vValue Then
VINTERPOLATEC =Table_Array.Cells(rng.Rows.Count, Col_Num).Value2
Exit Function
End If
'如果Lookup_Value不在rng中则返回错误
If Lookup_Value > vValue Or Lookup_Value < rng.Cells(1).Value2Then
VINTERPOLATEC = CVErr(xlErrNA)
Exit Function
End If
'使用MATCH查找行号
jRow = Application.WorksheetFunction.Match(Lookup_Value, rng, 1)
'获取2行数据
vArr = Table_Array.Resize(2).Offset(jRow - 1, 0).Value2
VINTERPOLATEC = (vArr(1, Col_Num) + _
(vArr(2, Col_Num) - vArr(1, Col_Num)) * _
(Lookup_Value - vArr(1, 1)) / (vArr(2, 1) - vArr(1, 1)))
Exit Function
FuncFail:
VINTERPOLATEC = CVErr(xlErrValue)
End Function
下面是代码的图片版:
小结:唯一比将所有数据一次性传递到VBA中更快的方法是,使用Excel函数且仅传递给该函数所需的最少数据。