自定义查找功能

Ale*_*der 2 excel vba function excel-vba

我正在尝试创建一个函数,在搜索整个活动工作表之后,将返回包含特定字符串的单元格总数.很像查找和替换中的"x单元格"如何工作.

到目前为止我有这个:

Function FINDIST(stringToFind)
Dim counter As Integer: counter = 0
For Each Cell In ActiveSheet.UsedRange.Cells
If InStr (Cell, stringToFind) > 0
Then counter = counter + 1
End If
Next
End Function
Run Code Online (Sandbox Code Playgroud)

Ioa*_*nis 9

另一种方法:

Function FINDIST(stringToFind) As Long
    FINDIST = Evaluate("SUM(IFERROR(SEARCH(" & Chr(34) _
        & "*" & stringToFind & "*" & Chr(34) & "," _
            & ActiveSheet.UsedRange.Address & ",1),0))")
End Function
Run Code Online (Sandbox Code Playgroud)

这将stringToFind在使用范围内的每个单元格中搜索,如果在单元格中找到该字符串,则返回一个数组,如果找不到则返回错误.使用IFERROR零件将错误转换为零,并将SUM得到的二进制数组求和.

这只会stringToFind在每个单元格中出现一次,即使它出现不止一次,但是看看你的代码,我认为这就是你要找的东西.

我希望它有所帮助!

UPDATE

出于好奇,我做了一些测试,看看这两种方法的比较(直接从范围读取到使用评估).这是我使用的代码:

Option Explicit
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Sub test()
Dim ticks As Long
Range("A1:AA100000").Value = "adlrkjgalbabyajglakrjg"

ticks = GetTickCount
FINDIST1 ("baby")
Debug.Print "Read from range: ", GetTickCount - ticks

ticks = GetTickCount
FINDIST ("baby")
Debug.Print "Evaluate: ", GetTickCount - ticks

End Sub

Function FINDIST(stringToFind) As Long
    FINDIST = Evaluate("SUM(IFERROR(SEARCH(" & Chr(34) _
    & "*" & stringToFind & "*" & Chr(34) & "," _
      & ActiveSheet.UsedRange.Address & ",1),0))")
End Function


Function FINDIST1(stringToFind) As Long
Dim counter As Long: counter = 0
Dim c As Range
Dim firstAddress As String

With ActiveSheet.UsedRange
    Set c = .Find(stringToFind, LookIn:=xlValues, LookAt:=xlPart)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            counter = counter + 1
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

FINDIST1 = counter

End Function
Run Code Online (Sandbox Code Playgroud)

更新2

Chris Nielsen在下面的评论中提出了两个非常好的观点:

  • ActiveSheet.Evaluate比...更快Application.Evaluate.查尔斯威廉姆斯在评论中与文本的链接解释了这种行为.
  • 好的旧Variant数组将比任何其他方法表现更好.

为了完整性,我发布了variant我测试的数组方法的版本:

Function FINDIST_looping(stringToFind) As Long
    Dim vContents, lRow As Long, lCol As Long, lCounter As Long

    vContents = ActiveSheet.UsedRange.Value2
    For lRow = LBound(vContents, 1) To UBound(vContents, 1)
        For lCol = LBound(vContents, 2) To UBound(vContents, 2)
            lCounter = IIf(InStr(vContents(lRow, lCol), stringToFind), _ 
               lCounter + 1, lCounter)
        Next lCol
    Next lRow

FINDIST_looping = lCounter

End Function
Run Code Online (Sandbox Code Playgroud)

Doug Glancy提出了另一个非常好的观点,即COUNTIF可以用来代替SEARCH.这导致了非阵列公式解决方案,并且应该在性能方面支配我的原始公式.

这是Doug的公式:

FINDIST_COUNTIF = ActiveSheet.Evaluate("COUNTIF(" _
        & ActiveSheet.Cells.Address & "," & Chr(34) & "*"  _ 
          & stringToFind & "*" & Chr(34) & ")")
Run Code Online (Sandbox Code Playgroud)

事实上,道格的观点暗示没有Evaluate()必要.我们可以CountifWorksheetFunction对象调用.因此,如果目标是从电子表格调用此函数,则无需使用Evaluate()或将其包装在UDF- 它是COUNTIF具有通配符的典型应用程序.

结果:

  Read from range:           247,495 ms (~ 4 mins 7 secs)
  Application.Evaluate:        3,261 ms (~ 3.2 secs)
  Variant Array:               1,706 ms (~ 1.7 secs)
  ActiveSheet.Evaluate:        1,257 ms (~ 1.3 secs)
  ActiveSheet.Evaluate (DG):     602 ms (~ 0.6 secs)
  WorksheetFunction.CountIf (DG):550 ms (~ 0.55 secs)
Run Code Online (Sandbox Code Playgroud)

Application.Evaluate与使用Range.Find()(?!)相比,它似乎快了约75倍.此外,原始代码(Integer更改为Long)在~8秒内运行.

而且,在这种特殊情况下,它似乎Activesheet.Evaluate实际上比Variant数组更快.CountIf作为一种WorksheetFunction方法而Evaluate不是它之间的区别似乎很小.

CAVEAT:在其中stringToFind发现的频率UsedRange可能会影响几种方法的相对性能.我跑的Activesheet.EvaluateVariant Array方法与在上述范围内(A1:AA100000),但只有具有匹配的字符串的十个第一细胞.

结果(平均6次运行,差异非常小):

  Activesheet.Evaluate:        920 ms (~  1. sec)
  Variant Array:               1654 ms (~ 1.7 secs)
Run Code Online (Sandbox Code Playgroud)

这很有趣 - ActiveSheet.Evaluate在这种情况下似乎比变体数组稍微好一点(除非我在循环代码中做了一些可怕的事情,在这种情况下请告诉我).此外,该Variant方法的性能实际上是相对于字符串的频率不变的.

跑步是在EXCEL 2010下面进行的Win7.