自定义公式太慢

Question

我使用了各种指南、文档和教程来创建自定义公式。基本上，公式有两个参数ItemID和DateV。

=DP(ItemID,DateV)

Sub TurnOffStuff()
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
End Sub
Sub TurnOnStuff()
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Public Function DP(ItemID As Variant, Optional DateV As Variant)
Dim SheetName As Variant, RangeSl As Range, RangeTP As Range, RangeTP2 As Range, RangeTP1 As Range

Call TurnOffStuff

If ItemID = "" Then
DP = ""
Else
Set SheetName = ActiveWorkbook.Sheets("Prod")
Set RangeSl = SheetName.Range("A:A")
If DateValue(DateV) < DateValue("Sep/01/2021") Then
Set RangeTP1 = SheetName.Range("G:G") 'TP_210901
DP = WorksheetFunction.index(RangeTP1, WorksheetFunction.Match(ItemID, RangeSl, 0))
ElseIf DateValue(DateV) < DateValue("Dec/07/2021") Then
Set RangeTP2 = SheetName.Range("F:F") 'TP_211207
DP = WorksheetFunction.index(RangeTP2, WorksheetFunction.Match(ItemID, RangeSl, 0))
Else
Set RangeTP = SheetName.Range("E:E")
DP = WorksheetFunction.index(RangeTP, WorksheetFunction.Match(ItemID, RangeSl, 0))
End If
End If

Call TurnOnStuff
End Function

代码工作，但由于我已将其添加到表中，每个单元格编辑到表中现在需要大约5秒。我正在测试的表有3000行，但实际文件的数量要高得多。

有可能加速这个函数吗?我是初学者。

Answer 1

用LOOKUP代替INDEX和MATCH。注意:我已将日期字符串更改为我的本地格式。你需要把它们改回来。

Public Function DP(ItemID As Variant, Optional DateV As Variant) As Variant
Dim i As Integer

If ItemID = "" Then
DP = ""
Else
If DateValue(DateV) < DateValue("2021-09-01") Then
i = 7
ElseIf DateValue(DateV) < DateValue("2021-12-07") Then
i = 6
Else
i = 5
End If
DP = WorksheetFunction.VLookup(ItemID, Range("Prod!A:G"), i, False)
End If
End Function

你可以用这个子

测试执行时间

Sub Test()

repetitions = 1000

startTime = VBA.DateTime.Timer
For i = 1 To repetitions
x = DP("Value3", "2021-12-24")
endTime = VBA.DateTime.Timer
Next i
Debug.Print "This code ran in " & (endTime - startTime) & " seconds"

End Sub

我使用了一个4300行的示例数据。使用VLOOKUP的实现耗时0.02s，而您的实现耗时25s(重复1000次)。

Answer 2

1. 删除udf中的TurnOnStuff和TurnOffStuff，这会使它变慢，并且它根本没有帮助，因为函数中的代码不会做任何影响您关闭的事情。

2. 我使你的函数更苗条一些，但这或多或少是为了不重复代码。我使用的一些变量可能也有小的影响。

3. Variant是最差的类型。如果您可以声明更精确，例如对于文本使用` ` String '。这也有好处。

Option Explicit
Public Function DP(ByVal ItemID As Variant, Optional ByVal DateV As Variant) As Variant
If ItemID = vbNullString Then
DP = vbNullString
Else
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Prod")

Dim MatchRange As Range
Set MatchRange = ws.Range("A:A")

Dim IdxRange As Range
If DateValue(DateV) < DateValue("Sep/01/2021") Then
Set IdxRange = ws.Range("G:G") 'TP_210901
ElseIf DateValue(DateV) < DateValue("Dec/07/2021") Then
Set IdxRange = ws.Range("F:F") 'TP_211207
Else
Set IdxRange = ws.Range("E:E")
End If
DP = WorksheetFunction.Index(IdxRange, WorksheetFunction.Match(ItemID, MatchRange, 0))
End If
End Function

请注意，在大多数情况下，使用VBA比使用公式慢。VBA只能使用单线程，而公式则不限于此。如果你经常用到这个函数，可能会花一些时间。你不能反对它。尽量使用公式，避免使用udf和VBA。