使用IF或Select Case的Excel UDF具有更好的性能
我经常需要在Excel中search单元格中某些特殊文本的公式。 我需要search的行数是100.000到500.000，在罕见的情况下高达1.000.000。 为了避免长公式，我写了一个自己的UDF来search单元格中的多个文本string。 新的公式很难处理。 我尽可能优化这个公式的运行时间。 500.000行需要11到12秒。
我用两种方法做了这个公式：一个使用IF语句（SuchenSIF），另一个（SuchenSSELCASE）使用SELECT CASE语句。 展位公式具有相同的速度。 你能给我一些提示如何获得更好的performance吗？
这个公式的语法是：
SuchenSIF（细胞search，文本search1，…文本search6）
SuchenSSELCASE（单元格search，文本search1，…文本search6）
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 在所有instr调用之前，通过将单元格值转换为string一次，而不是强制每个调用的string转换变体，都可以提高速度。
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刷新，错误/
如果您将UDF转换为处理单元格范围并返回结果数组，则可以创build更快的UDF：请参见https://fastexcel.wordpress.com/2011/06/20/writing-efiicient-vba-udfs -part5-UDF-数组公式-GO-更快/
你可以创build一个只包含已传递给函数的参数的数组，并通过该数组获得一点速度增益（…我想）
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
你没有提供任何数据你如何使用这个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