Excel宏嵌套循环执行报错求助：7000×4000行数据匹配优化方案

嘿，我太懂你这种崩溃的感受了——7000×4000的嵌套循环直接干出2800万次比对，Excel不卡死才怪！这种暴力循环完全没必要，咱们换几种高效的思路，分分钟解决问题。

核心问题分析 #

原代码最大的两个坑：

1. 嵌套循环导致时间复杂度爆炸：O(n*m)的复杂度，数据量一大直接扛不住；
2. 频繁读写工作表单元格：每一次Cells(i,27)这种调用都要和Excel交互，比内存操作慢几百倍。

下面给你几个落地的优化方案，按推荐程度排序：

方案1：用Scripting.Dictionary做快速查找（最推荐） #

字典是哈希表结构，查找时间是O(1)，把Sheet2的目标数据先存进字典，再遍历Sheet1直接查字典，总复杂度降到O(n+m)，速度提升几十倍都不止。

优化后代码：

Sub CountMatchesWithDictionary()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim arr2 As Variant
    Dim dict As Object
    Dim i As Long, counter As Long
    Dim ownerFullName As String
    
    ' 关闭Excel的耗时操作，提速必备
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' 定义工作表对象，避免重复写长名称
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("APN'i buraya tasi")
    Set dict = CreateObject("Scripting.Dictionary") ' 后期绑定，不用加引用
    
    ' 把Sheet2的所有者姓名读到数组，再存进字典
    arr2 = ws2.Range("B2:B" & ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row).Value
    For i = LBound(arr2) To UBound(arr2)
        ownerFullName = arr2(i, 1)
        If Not dict.Exists(ownerFullName) Then
            dict.Add ownerFullName, 1 ' 键是姓名，值可以是任意，这里存1就行
        End If
    Next i
    
    ' 遍历Sheet1，查字典计数
    counter = 0
    For i = 2 To ws1.Cells(ws1.Rows.Count, 27).End(xlUp).Row
        ownerFullName = ws1.Cells(i, 27).Value & " " & ws1.Cells(i, 28).Value
        If dict.Exists(ownerFullName) Then
            counter = counter + 1
        End If
    Next i
    
    ' 输出结果，你可以改成自己需要的操作
    MsgBox "匹配数量：" & counter
    
    ' 恢复Excel设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    ' 释放对象
    Set dict = Nothing
    Set ws1 = Nothing
    Set ws2 = Nothing
End Sub

为什么快？

• 先把Sheet2的所有姓名一次性读到数组，再存字典，只和工作表交互1次；
• 字典查找是哈希匹配，比逐行循环快N倍，7000次查找瞬间完成。

方案2：用数组替代直接单元格读写（次推荐） #

如果暂时不想用字典，至少把两个表的数据都读到数组里再循环，避免频繁读写工作表，速度也能提升不少。

优化后代码：

Sub CountMatchesWithArrays()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim arr1 As Variant, arr2 As Variant
    Dim i As Long, j As Long, counter As Long
    Dim ownerFullName As String
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("APN'i buraya tasi")
    
    ' 把两个表的目标列读到数组
    arr1 = ws1.Range("A2:AB" & ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row).Value ' 包含B27、B28列
    arr2 = ws2.Range("B2:C" & ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row).Value ' 包含B列姓名
    
    counter = 0
    For i = LBound(arr1) To UBound(arr1)
        ownerFullName = arr1(i, 27) & " " & arr1(i, 28) ' 第27、28列是原Cells(i,27)、(i,28)
        For j = LBound(arr2) To UBound(arr2)
            If ownerFullName = arr2(j, 1) Then ' arr2的第1列是原B列
                counter = counter + 1
                Exit For ' 找到匹配就跳出内层循环，不用继续比对
            End If
        Next j
    Next i
    
    MsgBox "匹配数量：" & counter
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    Set ws1 = Nothing
    Set ws2 = Nothing
End Sub

关键优化点：

• 一次性把数据读到数组，内存操作比单元格读写快几百倍；
• 找到匹配后用Exit For跳出内层循环，减少不必要的比对。

方案3：用Excel内置函数（零代码/少代码） #

如果不需要复杂的后续操作，直接用COUNTIF函数就能搞定，完全不用写循环：

1. 在Sheet1的空白列（比如列AC）的第2行输入公式：

   =IF(COUNTIF('APN'i buraya tasi'!$B:$B, CONCATENATE(AB2, " ", AC2))>0,1,0)
   

2. 下拉填充到所有行，最后用SUM函数统计这一列的和，就是匹配的数量。

或者用VBA调用内置函数：

Sub CountWithFunction()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, counter As Long
    
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("APN'i buraya tasi")
    lastRow1 = ws1.Cells(ws1.Rows.Count, 27).End(xlUp).Row
    
    counter = WorksheetFunction.Sum(ws1.Range("AC2:AC" & lastRow1))
    MsgBox "匹配数量：" & counter
End Sub

方案4：用Power Query（无代码方案） #

如果你不擅长VBA，Power Query是更简单的选择：

1. 把两个表都导入Power Query（数据→自表格/区域）；
2. 对Sheet1的姓名列做合并（把第27、28列合并成一个完整姓名）；
3. 用"合并查询"功能，匹配Sheet2的姓名列；
4. 筛选出匹配的行，统计数量即可。

通用提速小技巧 #

不管用哪种方案，都建议加上这几句代码，能大幅降低VBA运行时的负担：

Application.ScreenUpdating = False ' 关闭屏幕刷新
Application.Calculation = xlCalculationManual ' 手动计算
Application.EnableEvents = False ' 禁用事件触发

记得运行完后再恢复这些设置！

内容的提问来源于stack exchange，提问作者BERKAY KÜÇÜK