Question

我正在尝试创建一个函数，在搜索整个活动工作表之后，将返回包含特定字符串的单元格总数。很像＆＃34; x细胞如何发现＆＃34;在查找和替换中工作。

到目前为止，我有这个：

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

Answer 1

另一种方法：

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

这将在使用范围内的每个单元格中搜索stringToFind，如果在单元格中找到该字符串，则返回一个数组，如果找不到，则返回错误。 IFERROR部分将错误转换为零，SUM对生成的二进制数组求和。

这只会在每个单元格中出现stringToFind时计算一次，即使它出现多次，但查看代码时我会认为这就是您要查找的内容。

我希望它有所帮助！

<强>更新

出于好奇，我做了一些测试，看看两种方法的比较方式（直接从范围读取到使用评估）。这是我使用的代码：

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

更新2

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

ActiveSheet.Evaluate比Application.Evaluate快。 Charles Williams在评论中与文本的链接解释了这种行为。
好的旧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

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

这是Doug的公式：

FINDIST_COUNTIF = ActiveSheet.Evaluate("COUNTIF(" _
        & ActiveSheet.Cells.Address & "," & Chr(34) & "*"  _ 
          & stringToFind & "*" & Chr(34) & ")")

事实上，道格的观点暗示不需要Evaluate()。我们可以从Countif对象中调用WorksheetFunction。因此，如果目标是从电子表格中调用此函数，则无需使用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)

与使用Application.Evaluate相比，Range.Find()似乎快了约75倍（？！）此外，原始代码（Integer更改为Long）运行于~8秒。

此外，在这种特殊情况下，似乎Activesheet.Evaluate实际上比Variant数组更快。将CountIf作为WorksheetFunction方法与Evaluate方法进行调用之间的区别似乎很小。

CAVEAT ：在stringToFind中找到UsedRange的频率可能会影响多种方法的相对性能。我使用上述范围Activesheet.Evaluate运行Variant Array和(A1:AA100000)方法，但只有十个第一个单元格具有匹配的字符串。

结果（平均6次运行，差异非常小）：

  Activesheet.Evaluate:        920 ms (~  1. sec)
  Variant Array:               1654 ms (~ 1.7 secs)

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

在EXCEL 2010下Win7下进行了

运行。

Answer 2

使用Tony Dallimore建议使用Find并将返回类型更改为Long。

MSDN文章：http://msdn.microsoft.com/en-us/library/office/ff839746(v=office.15).aspx

Function FINDIST(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

FINDIST = counter

End Function

查找通常比编码等效文件更快，但我没有对其他任何内容进行速度测试，如果速度很快或者速度慢，我会对此感兴趣。

自定义查找功能

2 个答案: