excel - 自定义公式太慢

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 测试执行时间

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 次重复)。