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

fhg3lkii  于 2022-11-18  发布在  其他
关注(0)|答案(3)|浏览(147)

我经常需要在Excel中用公式搜索单元格中的一些特殊文本。我需要搜索的行数是100. 000到500. 000,在罕见的情况下高达1.000.000。为了避免长的公式,我写了一个自己的UDF来搜索多个文本字符串在一个单元格。新的公式是短处理。我优化了这个公式的运行时间,我可以好。500.000行需要11到12秒。
我用两种方法得出了这个公式:一个使用IF语句(SuchenSIF),另一个(SuchenSSELCASE)使用SELECT CASE语句。Booth公式具有相同的速度。您能给予我一些提示如何获得更好的性能吗?

  • 此公式的语法为:*

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
3okqufwl

3okqufwl1#

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

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

如果要大量调用UDF,则需要避免VBE Refresh错误:请参阅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/

5vf7fwbs

5vf7fwbs2#

您可以创建一个数组,其中只包含传递给函数的参数,然后通过该数组循环以获得一点速度增益(......我认为)

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
5ssjco0h

5ssjco0h3#

您没有提供任何数据说明您如何使用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

相关问题