自定义公式太慢

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

该代码有效，但由于我已将其添加到 table，现在对 table 的每个单元格编辑大约需要 5 秒。我正在测试的 table 有 3000 行，但真实文件的数量要多得多。

是否可以加速此功能？我是初学者。

Answer 1

删除 UDF 中的 TurnOnStuff 和 TurnOffStuff，这会使速度变慢并且根本没有帮助，因为函数中的代码不会做任何影响你关闭了什么。
我让你的函数稍微精简了一些，但这或多或少是为了避免重复代码。我少用了一些可能影响不大的变量。
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.

Answer 2

使用 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

测试执行时间

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.02 秒，而您的实现耗时 25 秒（重复 1000 次）。

自定义公式太慢

Custom Formula too slow

excel

vba