学习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使用快速排序以及二进制搜索代替循环的版本将快一个数量级！
小结：通过一步步改进函数代码，加快函数的执行速度。
|
|
转播
