优化Excel CountIfs - 我可以让它更快吗？

Question

我需要一些更大的文件来验证数据。我大部分都是自动输入我需要的公式。这有助于消除大文件上的复制和粘贴错误。问题在于最新的验证。

最新的验证之一涉及计算与3列匹配的行数。 3列在Sheet 2中，要计数的行在Sheet 1中。然后将此计数与基于Sheet 2的预期数量进行比较。使用CountIF很容易，但是有大文件，它可能需要占用其中一些人一个小时。我想找到更快的东西。

我正在使用较小的文件，它仍然需要大约1分钟。只有大约1800行。

我有这样的事情：

在Check1中我使用：= COUNTIFS（Sheet1！A：A，A2，Sheet1！B：B，B2，Sheet1！C：C，C2）

我的代码将该公式放入活动单元格中。有更好的方法吗？

无论如何 - 使用VB或其他东西 - 来提高性能。 当行开始进入成千上万时，是时候开始这个并获得午餐。然后，当我回到我的办公桌时希望它完成！

感谢。

Answer 1

您基本上必须迭代每列的所有行，这很昂贵。您可以将其拆分为两个任务：

1. 将您的列A-C合并为一个值=CONCAT(A2,B2,C2)
2. 然后在此列=COUNTIF(D:D,D2)
上只执行一个countif

通过这种方式，您可以以新的concat为代价摆脱两个（时间）昂贵的商品。

Answer 2

您应该将CountIf作用于整个列的范围缩小到实际使用的范围

您的代码可以编写公式的结果而不是公式本身

如下：

With Sheet1
    Set sheet1Rng = Intersect(.UsedRange, .Range("A:C"))
End With

With Sheet2
    For Each cell in Intersect(.UsedRange, .Range("A:A"))
        cell.Offset(,3) = WorksheetFunction.CountIfs(sheet1Rng.Columns(1), cell.Value, sheet1Rng.Columns(2), cell.Offset(,1).Value, sheet1Rng.Columns(3),cell.Offset(2).Value)
    Next cell
End With

Answer 3

我使用类似于您显示的布局设置了一个模拟工作表，包含10,000行，并使用您显示的COUNTIFS公式手动填充它。更改数据中的单个项目会触发重新计算，大约需要十秒左右才能执行。

然后我尝试了下面的宏，它在一秒钟内完成。所有计数都在VBA宏中完成。所以这个字典方法可能是你的速度问题的答案。

在运行此操作之前，如果工作表上有COUNTIFS，则可能需要将计算状态设置为手动（或在代码中执行）。

Option Explicit
'set reference to Microsoft Scripting Runtime

Sub CountCol123()
    Dim DCT As Dictionary
    Dim V As Variant
    Dim WS As Worksheet, R As Range
    Dim I As Long
    Dim sKey As String

Set WS = Worksheets("sheet2")

'read the info into an array
With WS
    Set R = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=4)
    V = R
End With

'Get count of the matches
Set DCT = New Dictionary
For I = 2 To UBound(V, 1)
    sKey = V(I, 1) & "|" & V(I, 2) & "|" & V(I, 3)
    If DCT.Exists(sKey) Then
        DCT(sKey) = DCT(sKey) + 1
    Else
        DCT.Add Key:=sKey, Item:=1
    End If
Next I

'Get the results and write them out
For I = 2 To UBound(V, 1)
    sKey = V(I, 1) & "|" & V(I, 2) & "|" & V(I, 3)
    V(I, 4) = DCT(sKey)
Next I

'If you have COUNTIFS on the worksheet when testing this,
' or any other formulas that will be triggered,
' then uncomment the next line
'Application.Calculation = xlCalculationManual

With R
    .EntireColumn.Clear
    .Value = V
End With

End Sub