Excel中如何用VBA实现COUNTIFS逻辑 解决公式运行卡顿崩溃问题

完全可以用VBA实现，运行效率远高于整列COUNTIFS公式，不会出现卡顿崩溃问题，具体实现如下：

逻辑说明 #

原公式=IF(COUNTIFS($E:$E,E2,$A:$A,"<>"&A2)>0,"Yes","No")的作用是：判断当前行E列的值，是否存在「对应A列和当前行A列不相等」的其他行，存在则返回Yes，否则返回No。
VBA方案采用字典存储E值对应的所有A列值集合，仅需遍历2次数据即可完成全部计算，时间复杂度为O(n)，远低于公式逐行全列匹配的O(n²)复杂度。

操作步骤 #

• 按下Alt+F11打开VBA编辑器
• 点击「插入」-「模块」，将下方代码粘贴到模块窗口中
• 按下F5运行即可

VBA代码 #

Sub 匹配E列重复值()
    Dim lastRow As Long
    Dim dict As Object
    Dim arrData As Variant
    Dim arrResult As Variant
    Dim i As Long
    Dim eVal, aVal
    
    '关闭屏幕更新和自动计算，大幅提升运行速度
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    '获取当前工作表数据最后一行行号
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    '把A、E列数据一次性读入数组，比逐行读取单元格快数十倍
    arrData = Range("A1:E" & lastRow).Value
    '初始化结果数组
    ReDim arrResult(1 To lastRow, 1 To 1)
    
    '创建字典存储E值对应的所有A值
    Set dict = CreateObject("Scripting.Dictionary")
    '第一次遍历：汇总所有E值对应的A值集合
    For i = 2 To lastRow '如果表格没有表头，把2改成1
        eVal = arrData(i, 5) 'E列是A:E区域的第5列
        aVal = arrData(i, 1) 'A列是A:E区域的第1列
        If Not dict.exists(eVal) Then
            Set dict(eVal) = CreateObject("Scripting.Dictionary")
        End If
        '同一个E值下重复的A值只存一次
        If Not dict(eVal).exists(aVal) Then
            dict(eVal).Add aVal, True
        End If
    Next i
    
    '第二次遍历：生成U列结果
    For i = 2 To lastRow '如果没有表头，把2改成1
        eVal = arrData(i, 5)
        '如果当前E值对应2个及以上不同A值，说明存在符合条件的行
        If dict(eVal).Count > 1 Then
            arrResult(i, 1) = "Yes"
        Else
            arrResult(i, 1) = "No"
        End If
    Next i
    
    '把结果一次性写入U列
    Range("U1:U" & lastRow).Value = arrResult
    '如果需要表头可以取消注释下一行
    'Range("U1") = "匹配结果"
    
    '恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Set dict = Nothing
End Sub

注意事项 #

• 代码生成的是静态结果，A、E列数据更新后重新运行一次即可更新U列内容
• 10万行以内的数据运行时间基本在1秒以内，不会出现卡顿
• 如果不需要保留公式关联，运行完成后可以直接保存文件，无需启用宏

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