Excel VBA解读（141）：自定义函数性能改进示例

fanjy

发布于 2019-07-19 14:50:30

1.3K0

发布于 2019-07-19 14:50:30

文章被收录于专栏：完美Excel完美Excel

学习Excel技术，关注微信公众号：

excelperfect

Pedro想知道怎样加速他的自定义函数，该函数需要计算35040个单元格的结果，即单元格与未知长度值列之间的最小差异。

其函数代码为：

Function MinofDiff(r1 As Long) AsVariant
   Dim r2 As Range
   Dim TempDif As Variant
   Dim TempDif1 As Variant
   Dim j As Long
   Dim LastRow As Long
   On Error GoTo FuncFail
   If r1 = 0 Then GoTo skip
   With Sheets("Dados")
        LastRow = .Cells(.Rows.Count,"P").End(xlUp).Row
        Set r2 = .Range("P8","P" & LastRow)
   End With
   TempDif1 = Application.Max(r2)
   For j = 1 To LastRow - 7
        If r1 >= r2(j) Then
            TempDif = r1 - r2(j)
        Else
            TempDif = r1
        End If
        MinofDiff = Application.Min(TempDif,TempDif1)
        TempDif1 = MinofDiff
   Next j
skip:
   Exit Function
FuncFail:
   MinofDiff = CVErr(xlErrNA)
End Function

该自定义函数存在一个基本问题：它引用列P中的一个区域而不将其作为参数传递，因此如果P列中的任何更改，该函数可能会给出错误的答案，因为Excel不会重新计算它。Pedro已完成此操作，以便这个用户定义函数可以动态调整到列P中的条目数。

这个函数运行速度慢的原因：

每次调用该函数时，它会在P列中找到最后一行和最大值，但这只需要做一次。
35040次调用将触及VBE刷新减速的Bug，所以需要绕过它。
For循环引用列P中每个单元格值（使用R2（j））两次。对单元格的每个引用都很慢，因为每次调用Excel对象模型都会产生很大的开销。
UDF使用Worksheetfunction.Min来找出哪两个值更小：使用VBA的If语句比调用工作表函数更快地比较值。

修改后的用户定义函数

为了解决这个用户定义函数的基本问题，将向它传递另外一个参数：对列P的整列引用。然后，该函数可以将区域调整为包含数据的最后一个单元格。（另一种方法是为列P创建动态命名区域并将其作为参数传递）。

为了解决前两个使速度变慢的问题，该用户定义函数将被制作成数组公式自定义函数，返回35040结果的数组。

为了避免在循环内两次引用列P中的每个单元格，该函数将从列P中获取所有值一次，变为变体数组，然后在该变体数组上循环。

Function MinofDiff2(R1 As Range,R2 As Range) As Variant
   Dim R2Used As Range
   Dim vArr2 As Variant
   Dim vArr1 As Variant
   Dim vOut() As Double
   Dim TempDif As Double
   Dim TempDif1 As Double
   Dim D1 As Double
   Dim D2 As Double
   Dim TMax As Double
   Dim j1 As Long
   Dim j2 As Long
   Dim LastRow As Long
   On Error GoTo FuncFail
   LastRow = R2.Cells(R2.Rows.Count, 1).End(xlUp).Row
   Set R2Used = R2.Resize(LastRow - 7, 1).Offset(7, 0)
   vArr2 = R2Used.Value2
   vArr1 = R1.Value2
   TMax = Application.Max(R2Used)
   ReDim vOut(1 To UBound(vArr1), 1)
   For j1 = 1 To UBound(vArr1)
        TempDif1 = TMax
        D1 = vArr1(j1, 1)
        For j2 = 1 To (LastRow - 7)
            D2 = vArr1(j2, 1)
            If D1 >= D2 Then
                TempDif = D1 - D2
            Else
                TempDif = D1
            End If
            If TempDif < TempDif1 Then
                vOut(j1, 1) = TempDif
            Else
                vOut(j1, 1) = TempDif1
            End If
            TempDif1 = vOut(j1, 1)
        Next j2
   Next j1
   MinofDiff2 = vOut
skip:
   Exit Function
FuncFail:
   MinofDiff2 = CVErr(xlErrNA)
End Function

因为这是一个数组函数，所以需要选择要包含答案的35040单元格，然后在公式栏中键入公式=MinofDiff2(A1：A35040，P：P)，再按Ctrl+Shift+Enter组合键在35040个单元格中输入数组公式。

这个修改版本提升了函数的运行速度。

进一步改进版

下面的代码经过再次改进，速度更快。

Function MinofDiff3(R1 As Range,R2 As Range) As Variant
   Dim R2Used As Range
   Dim vArr2 As Variant
   Dim vArr1 As Variant
   Dim vOut() As Double
   Dim TempDif As Double
   Dim TempDif1 As Double
   Dim D1 As Double
   Dim D2 As Double
   Dim TMax As Double
   Dim TMin As Double
   Dim j1 As Long
   Dim j2 As Long
   Dim LastRow As Long
   On Error GoTo FuncFail
    ' 处理完整的列
   LastRow = R2.Cells(R2.Rows.Count, 1).End(xlUp).Row - 7
   Set R2Used = R2.Resize(LastRow, 1).Offset(7, 0)
    ' 将值写入数组
   vArr2 = R2Used.Value2
   vArr1 = R1.Value2
    ' 查找最大值 & 最小值
   TMax = Application.Max(R2Used)
   TMin = Application.Min(R2Used)
    ' 设置输出数据与R1相同大小
   ReDim vOut(1 To UBound(vArr1), 1)
    ' 遍历R1
   For j1 = 1 To UBound(vArr1)
        TempDif1 = TMax
        D1 = vArr1(j1, 1)
        TempDif = D1 - TMax
        If D1 > TMax Then
            If TempDif < TMax Then
                 vOut(j1, 1) = TempDif
            Else
                vOut(j1, 1) = TMax
            End If
        Else
            If D1 < TMin Then
                vOut(j1, 1) = D1
            Else
                ' 遍历R2
                For j2 = 1 To LastRow
                    D2 = vArr2(j2, 1)
                    If D1 >= D2 Then
                        TempDif = D1 - D2
                    Else
                        TempDif = D1
                    End If
                    If TempDif < TempDif1Then TempDif1 = TempDif
                    vOut(j1, 1) = TempDif1
                Next j2
            End If
        End If
   Next j1
   MinofDiff3 = vOut
skip:
   Exit Function
FuncFail:
   MinofDiff3 = CVErr(xlErrNA)
End Function

进一步，对R2使用快速排序以及二进制搜索代替循环的版本将快一个数量级！

小结：通过一步步改进函数代码，加快函数的执行速度。

本文参与腾讯云自媒体分享计划，分享自微信公众号。

原始发表：2019-05-07，如有侵权请联系 cloudcommunity@tencent.com 删除

编程算法

本文分享自完美Excel 微信公众号，前往查看

如有侵权，请联系 cloudcommunity@tencent.com 删除。

本文参与腾讯云自媒体分享计划，欢迎热爱写作的你一起参与！

编程算法

登录后参与评论

0 条评论

热度