All geek questions in one place

Better performance in Excel UDF with IF or Select Case

I often need to search Excel formulas for some special texts in a cell. The number of lines that I need to search is from 100,000 to 500,000, in rare cases - up to 1,000,000. To avoid long formulas, I wrote my own UDF to search for multiple text strings in a cell. The new formula is short for processing. I optimize the execution time of this formula as good as I can. It takes 11 to 12 seconds for 500,000 rows.

I made this formula in two ways: one uses IF-Statement (SuchenSIF), the other (SuchenSSELCASE) uses SELECT CASE statements. Booth formulas have the same speed. Can you give me some hint on how to get the best performance?

The syntax for this formula is:
SuchenSIF (search cell, search text 1, ... search text 6)
SuchenSSELCASE (search cell, search text 1, ... search text 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
+4
source share
3 answers

You can make some speed boost by converting the cell value to a string once before all instr calls, rather than forcing the option to convert strings for each call.

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

If you have a large number of calls in UDF, you need to avoid the VBE update error: see 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/

+2

, 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
0

, , , , (... )

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
0

Source: https://habr.com/ru/post/1673974/

More articles:


All Articles