VBA实现Excel跨工作表列值比对返回匹配结果及错误计数问题求助

问题排查 #

• 不必要的双层循环导致运算量爆炸：你写了两层For循环，假设LRow和LRow1都是4000行，单次循环就有1600万次单元格写入操作，远超Excel处理上限，自然会卡死崩溃。而且你的内层循环变量r完全没有参与值对比逻辑，所有行的结果都会被最后一次外层循环的结果覆盖，必然出现全"No Match"的错误。
• 变量声明不规范：VBA中单行多变量声明时每个变量都要指定类型，你原有代码中i、LRow实际是Variant变体类型，不仅影响执行效率，还可能出现溢出风险。
• 对比逻辑和输出位置不匹配：你当前的对比逻辑只判断了Sheet4和Sheet3的A列，且输出位置固定在D列，完全没有匹配多列校验的需求，也没有实现错误数统计的功能。

修正后的代码 #

Sub ProductCheck()
    ' 统一声明变量类型
    Dim i As Long, col As Long
    Dim LRow As Long, LCol As Long
    Dim errCount As Long
    
    ' 关闭屏幕更新提升运行速度，避免卡顿
    Application.ScreenUpdating = False
    
    ' 原有复制逻辑保留，优化写法避免低效的Select操作
    Worksheets("Product Rec").Range("B4:AC5000").Clear
    Sheets("Demo Product Report").Range("A2:B5000").Copy _
        Destination:=Worksheets("Product Rec").Range("B4")
    
    ' 获取对比的最大行号和最大列号，取两个表的最小值避免越界
    LRow = WorksheetFunction.Min(Sheets(3).Range("A" & Rows.Count).End(xlUp).Row, _
        Sheets(4).Range("A" & Rows.Count).End(xlUp).Row)
    LCol = WorksheetFunction.Min(Sheets(3).UsedRange.Columns.Count, _
        Sheets(4).UsedRange.Columns.Count, 29) ' 29对应AC列，限制校验范围不超过AC列
    
    ' 逐行逐列对比并输出结果
    For i = 2 To LRow
        ' 输出行从D4开始，对比行i对应输出行i+2
        For col = 1 To LCol
            ' 输出列从D列（第4列）开始，对比列col对应输出列col+3
            If Sheets(4).Cells(i, col).Value = Sheets(3).Cells(i, col).Value Then
                Sheets(2).Cells(i + 2, col + 3).Value = "MATCH"
            Else
                Sheets(2).Cells(i + 2, col + 3).Value = "NO MATCH"
            End If
        Next col
    Next i
    
    ' 统计D2到AC2每列的错误数量
    For col = 4 To 29
        errCount = Application.WorksheetFunction.CountIf(Sheets(2).Range(Cells(4, col), Cells(LRow + 2, col)), "NO MATCH")
        Sheets(2).Cells(2, col).Value = errCount
    Next col
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
End Sub

优化说明 #

• 去掉无意义的嵌套循环，改为行、列各一层的遍历逻辑，运算量降低99%以上，不会再出现卡顿崩溃问题
• 新增错误数统计逻辑，直接调用CountIf函数统计每列的"No Match"数量写入第2行对应位置
• 优化了单元格操作逻辑，全程不使用Select类低效操作，配合关闭屏幕更新大幅提升运行速度
• 增加范围校验，避免读写超出表格边界触发报错

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