在具有IF或Select的Excel中性能更好

Question

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

我用两种方式创建了这个公式:一种使用IF-语句(SuchenSIF)，另一种(SuchenSSELCASE)使用SELECT CASE语句。布斯公式的速度是一样的。你能告诉我怎样才能获得更好的表现吗？

该公式的语法如下：

SuchenSIF(单元格搜索，文本搜索1，.要搜索的文本6)

SuchenSSELCASE(单元格搜索，文本搜索1，.要搜索的文本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

您没有提供任何数据，说明如何使用此Function以及您试图实现的目标。也许我们可以用更短更快的东西来代替你的整个Function概念。

编辑：删除了前面的概念，并决定将此版本与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 arguments 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

Answer 3

您可以创建一个数组，该数组只包含传递给函数的参数，并通过该参数进行循环以获得一定的速度增益(...I认为)

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