使用 IF 或 Select Case 在 Excel UDF 中获得更好的性能

Question

我经常需要在 Excel 中使用公式搜索单元格中的某些特殊文本。我需要搜索的行数是 100.000 到 500.000，在极少数情况下高达 1.000.000。为了避免长公式，我编写了自己的 UDF 来搜索单元格中的多个文本字符串。新公式很容易处理。我尽我所能优化这个公式的运行时间。 500.000 行需要 11 到 12 秒。

我以两种方式制作这个公式：一种使用 IF 语句 (SuchenSIF)，另一种 (SuchenSSELCASE) 使用 SELECT CASE 语句。布斯公式具有相同的速度。你能给我一些提示如何获得更好的性能吗？

这个公式的语法是：
SuchenSIF(要搜索的单元格，要搜索的文本 1，要搜索的文本 6)
SuchenSSELCASE(cell to search, text to search 1, ... text to search 6)

Public Function SuchenSIF(Zelle As Range, such1 As String, Optional such2 As String, Optional such3 As String, Optional such4 As String, Optional such5 As String, Optional such6 As String) As Integer
Application.Volatile

' this code, based on IF-statements need 11-12 seconds for 500.000 rows
' Start of IF-Section
'
ZelleWert = Zelle.Value
SuchenS = InStr(1, ZelleWert, such1, vbTextCompare)
If SuchenS > 0 Then Exit Function
SuchenS = InStr(1, ZelleWert, such2, vbTextCompare)
If SuchenS <> vbFalse Then Exit Function
If Len(such3) > 0 Then
    SuchenS = InStr(1, ZelleWert, such3, vbTextCompare)
    If SuchenS > 0 Then Exit Function
    If Len(such4) > 0 Then
        SuchenS = InStr(1, ZelleWert, such4, vbTextCompare)
        If SuchenS > 0 Then Exit Function
        If Len(such5) > 0 Then
            SuchenS = InStr(1, ZelleWert, such5, vbTextCompare)
            If SuchenS > 0 Then Exit Function
            If Len(such6) > 0 Then
                SuchenS = InStr(1, ZelleWert, such6, vbTextCompare)
                If SuchenS > 0 Then Exit Function
            End If
        End If
    End If
End If
'
' End of IF-Section
If SuchenS = 0 Then SuchenS = False
End Function

Public Function SuchenSSELCASE(Zelle As Range, such1 As String, Optional such2 As String, Optional such3 As String, Optional such4 As String, Optional such5 As String, Optional such6 As String) As Integer
Application.Volatile
' this code, based on SELECT-CASE-statements need 11-12 seconds for 500.000 rows
' Start of SELECT-CASE -Section
'
ZelleWert = Zelle.Value
SuchenS = InStr(1, ZelleWert, such1, vbTextCompare) * Len(such1)
Select Case SuchenS
    Case 0
        SuchenS = InStr(1, ZelleWert, such2, vbTextCompare) * Len(such2)
        Select Case SuchenS
            Case 0
                SuchenS = InStr(1, ZelleWert, such3, vbTextCompare) * Len (such3)
                Select Case SuchenS
                    Case 0
                        SuchenS = InStr(1, ZelleWert, such4, vbTextCompare) * Len(such4)
                        Select Case SuchenS
                            Case 0
                                SuchenS = InStr(1, ZelleWert, such5, vbTextCompare) * Len(such5)
                                Select Case SuchenS
                                    Case 0
                                        SuchenS = InStr(1, ZelleWert, such6, vbTextCompare) * Len(such6)
                                        Select Case SuchenS
                                            Case 0
                                            Case Else
                                                SuchenS = SuchenS / Len(such6)
                                                Exit Function
                                        End Select
                                    Case Else
                                        SuchenS = SuchenS / Len(such5)
                                        Exit Function
                                End Select
                            Case Else
                                SuchenS = SuchenS / Len(such4)
                                Exit Function
                        End Select
                    Case Else
                        SuchenS = SuchenS / Len(such3)
                        Exit Function
                End Select
            Case Else
                SuchenS = SuchenS / Len(such2)
                Exit Function
        End Select
    Case Else
        SuchenS = SuchenS / Len(such1)
        Exit Function
End Select
'
' End of SELECT-CASE -Section
If SuchenS = 0 Then SuchenS = False
End Function

Answer 1

您可以通过在所有 instr 调用之前将单元格值转换为字符串一次来提高速度，而不是在每次调用时强制将变体转换为字符串。

Dim ZelleWert as string
ZelleWert=Cstr(Zelle.Value2)

如果您对 UDF 有大量调用，则需要避免 VBE 刷新错误：请参阅 https://fastexcel.wordpress.com/2011/06/13/writing-efficient-vba-udfs-part-3-avoiding-the-vbe-refresh-bug/

如果您将 UDF 转换为处理单元格范围并返回结果数组，您可能会制作更快的 UDF：请参阅 https://fastexcel.wordpress.com/2011/06/20/writing-efiicient-vba-udfs-part5-udf-array-formulas-go-faster/

Answer 2

您可以创建一个仅包含已传递给函数的参数的数组，并通过该数组循环以获得一点速度增益（...我认为）

Public Function SuchenSIF(Zelle As Range, such1 As String, Optional such2 As String, Optional such3 As String, Optional such4 As String, Optional such5 As String, Optional such6 As String) As Integer
    Application.Volatile

    Dim possibleInputs As Variant, v As Variant, inputs As Variant
    Dim i As Integer
    Dim ZelleWert As String

    possibleInputs = Array(such2, such3, such4, such5, such6)

    'create an array of non-empty parameters
    ReDim inputs(0 To 0)
    inputs(0) = such1
    For i = 0 To 4
        If possibleInputs(i) <> vbNullString Then
            ReDim Preserve inputs(0 To UBound(inputs) + 1)
            inputs(UBound(inputs)) = possibleInputs(i)
        End If
    Next i

    ZelleWert = CStr(Zelle.Value)

    'loop through given parameters and exit if found
    For Each v In inputs
        SuchenS = InStr(1, ZelleWert, v, vbTextCompare)
        If SuchenS > 0 Then
            Exit Function
        End If
    Next v
End Function

Answer 3

您尚未提供任何数据，您如何使用此Function 以及您想要实现的目标。或许我们可以用更短、更快的方式替换您的整个 Function 概念。

编辑 1：删除了之前的概念，并决定将此版本与 Application.Match 一起使用。

Public Function SuchenSIF(Zelle As Range, such1 As String, Optional such2 As String, Optional such3 As String, Optional such4 As String, Optional such5 As String, Optional such6 As String) As Integer

    Dim suchArr() As String, Elem As Variant

    ReDim suchArr(0 To 5)

    ' create suchArr with only Such arguements that are none-blank
    For Each Elem In Array(such1, such2, such3, such4, such5, such6)
        If Elem <> vbNullString Then
            suchArr(i) = Elem
            i = i + 1
        End If
    Next Elem

    ReDim Preserve suchArr(0 To i - 1) ' resize to actual populated array size

    ' use Match to get the index of the array that is matched
    SuchenSIF = Application.Match(Zelle.Value, suchArr, 0) - 1

    If IsError(SuchenSIF) Then SuchenSIF = -10000  ' Just to Raise some kind of error "NOT found!"

End Function