Excel VBA解读（134）： 使用Excel函数提高自定义函数的效率
Excel VBA解读（134）： 使用Excel函数提高自定义函数的效率
学习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函数且仅传递给该函数所需的最少数据。