Excel 2019清除内容后计算缓慢 求替代COUNTIF公式的VBA方案

你遇到的性能问题主要来自两个核心原因：

• 公式本身的计算逻辑效率低下：你使用的=IF(A1<>A2,COUNTIF($A1:A$1,A1),"$$$")公式中，COUNTIF的统计范围会随着行号下移动逐行扩大，10万行数据下总计算量级为O(n²)，首次填充速度快是因为Excel刚启动时计算缓存为空、且会对首次批量填充的公式触发预优化的增量计算逻辑。
• 依赖链更新开销：首次填充完10万行公式后，Excel会生成完整的单元格依赖关系链，你清除B列内容时，Excel需要遍历所有10万行公式的依赖项逐一解绑、标记脏单元格，这个操作的开销远高于直接写入内容；清除后再次填充公式时，之前的缓存已被清空，还需要重新构建依赖链，因此速度远低于首次填充。

因为你的A列已经是排序状态，相同数值连续排列，只需单次遍历即可完成统计，直接输出结果到B列，不需要公式也不需要额外复制粘贴操作，代码如下：

Sub 统计连续相同值出现次数()
    Dim lastRow As Long
    Dim i As Long
    Dim startRow As Long
    ' 关闭屏幕更新和自动计算提升速度
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' 获取A列最后一行有数据的行号
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    startRow = 1 ' 数据起始行，如果有表头请修改为2
    
    For i = startRow To lastRow
        ' 判断当前行和下一行A列值是否不同
        If Cells(i, "A").Value <> Cells(i + 1, "A").Value Then
            ' 计算连续相同值的数量
            Cells(i, "B").Value = i - startRow + 1
            ' 重置下一段的起始行
            startRow = i + 1
        Else
            ' 相同则填入$$$
            Cells(i, "B").Value = "$$$"
        End If
    Next i
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "统计完成，共处理" & lastRow & "行数据"
End Sub

10万行数据上述代码执行时间通常不超过1秒，完全可以避免原方案的性能问题。

内容的提问来源于stack exchange，提问作者BradS