Question

正如标题所说。是否有任何函数或VBA代码与countif执行相同的功能并且速度更快。目前处于大规模的countif中间，它正在耗尽我的CPU。

它只是工作表中的基本countif。不在VBA中。 =countif(X:X,Y)然而，这些名单很大。所以这两个列表大约是100,000行

Answer 1

如果您可以不计算出现次数并且只想检查 y 列中是否存在值 x ，则返回布尔值TRUE或FALSE使用ISNUMBER function评估MATCH function查找将大大加快此过程。

=ISNUMBER(MATCH(S1, Y:Y, 0))

根据需要填写以获取所有回报。对返回的值进行排序和/或过滤以将结果制成表格。

<强>附录：

显然有。 MATCH function COUNTIF function计算时间的巨大改进使我想知道MATCH是否无法进入循环，将 lookup_array 参数中的第一个单元格推进到之前返回的行号加1，直到没有更多匹配。此外，后续的MATCh调用查找相同的数字（增加计数）可以通过按返回的行号调整列的高度来调整（缩小）列的高度来缩小（em）> lookup_array 单元格范围。如果处理后的值及其计数存储为脚本字典中的键和项，则可以立即解析重复值而无需处理计数。

Sub formula_countif_test()
    Dim tmr As Double
    appOFF
    tmr = Timer
    With Sheet2.Cells(1, 1).CurrentRegion
        With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) 'skip header
            .Cells(1, 3).Resize(.Rows.Count, 1).FormulaR1C1 = _
                "=countif(c1, rc2)"  'no need for calculate when blocking in formulas like this
        End With
    End With
    Debug.Print "COUNTIF formula: " & Timer - tmr
    appON
End Sub

Sub formula_match_test()
    Dim rw As Long, mrw As Long, tmr As Double, vKEY As Variant
    'the following requires Tools, References, Microsoft Scripting Dictionary
    Dim dVALs As New Scripting.dictionary

    dVALs.CompareMode = vbBinaryCompare  'vbtextcompare for non-case sensitive

    appOFF
    tmr = Timer

    With Sheet2.Cells(1, 1).CurrentRegion
        With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) 'skip header
            For rw = 1 To .Rows.Count
                vKEY = .Cells(rw, 2).Value2
                If Not dVALs.Exists(vKEY) Then
                    dVALs.Add Key:=vKEY, _
                        Item:=Abs(IsNumeric(Application.Match(vKEY, .Columns(1), 0)))
                    If CBool(dVALs.Item(vKEY)) Then
                        mrw = 0: dVALs.Item(vKEY) = 0
                        Do While IsNumeric(Application.Match(vKEY, .Columns(1).Offset(mrw, 0).Resize(.Rows.Count - mrw + 1, 1), 0))
                            mrw = mrw + Application.Match(vKEY, .Columns(1).Offset(mrw, 0).Resize(.Rows.Count - mrw + 1, 1), 0)
                            dVALs.Item(vKEY) = CLng(dVALs.Item(vKEY)) + 1
                        Loop
                    End If
                    .Cells(rw, 3) = CLng(dVALs.Item(vKEY))
                Else
                    .Cells(rw, 3) = CLng(dVALs.Item(vKEY))
                End If
            Next rw
        End With
    End With
    Debug.Print "MATCH formula: " & Timer - tmr
    dVALs.RemoveAll: Set dVALs = Nothing
    appON
End Sub

Sub appON(Optional ws As Worksheet)
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub appOFF(Optional ws As Worksheet)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
End Sub

Sample Data for MATCH_COUNTIF

我使用10K行，其中A列和B列填充RANDBETWEEN(1, 999)，然后复制并粘贴为值。

经过的时间：

  试验1 1 - 10K行×2列填充RANDBETWEEN（1,999）
  COUNTIF公式：15.488秒
  配比公式：1.592秒

  测试2² - 10K行×2列填充RANDBETWEEN（1,99999）
  COUNTIF公式：14.722秒
  匹配公式：3.484秒

  我还将COUNTIF公式中的值复制到另一列中，并将它们与编码MATCH函数返回的值进行比较。它们在10K行中是相同的。
  ¹^{更多倍数;零计数}
  ²^{更多零计数，更少倍数}

虽然数据的性质明显有显着差异，但编码MATCH功能每次都优于本机COUNTIF工作表功能。

不要忘记VBE的工具►参考资料►MicrosoftScripting Dictionary。

Answer 2

尝试sumproduct(countif(x:x,y:y))
速度稍快，但我不确定多少。
如果您有更好的选择，也请告诉我们。

Answer 3

对数据进行排序后，COUNTIF有一个简单的解决方法。您可以将其添加到您的VB脚本中，然后运行。对于包含约10万个订单项的数据，正常的COUNTIF需要近10-15分钟的时间。此脚本将在<10秒内获得计数。

Sub alternateFunctionForCountIF()
Dim DS As Worksheet
Set DS = ThisWorkbook.ActiveSheet

Dim lcol As Integer
lcol = DS.Cells(1, Columns.Count).End(xlToLeft).Column
Dim fieldHeader As String

Dim lrow As Long, i As Long, j As Long
Dim countifCol As Integer, fieldCol As Integer

fieldHeader = InputBox("Enter the column header to apply COUNTIF")
If Len(fieldHeader) = 0 Then
    MsgBox ("Invalid input. " & Chr(13) & "Please enter the column header text and try again")
    Exit Sub
End If
For i = 1 To lcol
    If fieldHeader = DS.Cells(1, i).Value Then
        fieldCol = i
        Exit For
    End If
Next i
If fieldCol = 0 Then
    MsgBox (fieldHeader & " could not be found among the headers. Please enter a valid column header")
    Exit Sub
End If

countifCol = fieldCol + 1
lrow = DS.Cells(Rows.Count, "A").End(xlUp).Row
DS.Range(DS.Cells(1, countifCol).EntireColumn, DS.Cells(1, countifCol).EntireColumn).Insert
DS.Cells(1, countifCol) = fieldHeader & "_count"

DS.Sort.SortFields.Clear
DS.Sort.SortFields.Add Key:=Range(DS.Cells(2, fieldCol), DS.Cells(lrow, fieldCol)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With DS.Sort
    .SetRange Range(DS.Cells(1, 1), DS.Cells(lrow, lcol))
    .header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Dim startPos As Long, endPos As Long
Dim checkText As String
For i = 2 To lrow
    checkText = LCase(CStr(DS.Cells(i, fieldCol).Value))

    If (checkText <> LCase(CStr(DS.Cells(i - 1, fieldCol).Value))) Then
        startPos = i
    End If
    If (checkText <> LCase(CStr(DS.Cells(i + 1, fieldCol).Value))) Then
        endPos = i
        For j = startPos To endPos
             DS.Cells(j, countifCol) = endPos - startPos + 1
        Next j
    End If
Next i
MsgBox ("Done")

结束子

是否有更快的CountIF

3 个答案: