学习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函数且仅传递给该函数所需的最少数据。