Excel VBA嵌套For循环运行缓慢且功能异常求助

我来帮你搞定这个问题！你的代码现在有两个核心问题：逻辑错误导致全表错误高亮，还有嵌套循环效率极低导致Excel假死。咱们一步步来修复：

一、原代码的核心问题分析 #

1. 逻辑错误：错误触发高亮 #

原代码中，每遍历一行预约数据（内层i循环），只要当前预约不匹配，就会立刻给请求行标红。但我们需要的是：只有当所有预约都不匹配时，才高亮该行。举个例子：如果某请求行在第5000行预约找到匹配，但前面的4999行都不匹配，代码会在第2行就把请求行标红，后续即使找到匹配也无法撤销，最终导致全表被错误高亮。

2. 性能问题：低效的单元格访问与冗余代码 #

• 硬编码行数（j=2 To 1000、i=2 To 10000）：要么处理大量空行浪费时间，要么漏处理实际存在的数据；
• 直接频繁访问Cells对象：Excel单元格访问速度远慢于数组操作，1000*10000次访问会导致严重卡顿；
• 重复代码：6个测试代码的判断逻辑完全一致，冗余且不易维护。

二、优化后的完整代码 #

Sub CheckAppointments()
    Dim wsReq As Worksheet, wsAppt As Worksheet
    Dim reqData As Variant, apptData As Variant
    Dim lastReqRow As Long, lastApptRow As Long
    Dim i As Long, j As Long, col As Long
    Dim hasMatch As Boolean
    
    ' 关闭Excel的耗时功能，提升速度
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    ' 定义工作表
    Set wsReq = ThisWorkbook.Sheets("C")
    Set wsAppt = ThisWorkbook.Sheets("B")
    
    ' 获取实际数据的最后一行，避免空循环或漏数据
    lastReqRow = wsReq.Cells(wsReq.Rows.Count, "A").End(xlUp).Row
    lastApptRow = wsAppt.Cells(wsAppt.Rows.Count, "A").End(xlUp).Row
    
    ' 将数据读取到数组，大幅提升访问速度
    reqData = wsReq.Range("A1:M" & lastReqRow).Value
    apptData = wsAppt.Range("A1:P" & lastApptRow).Value
    
    ' 先清除所有之前的高亮，避免残留
    wsReq.Rows("2:" & lastReqRow).Interior.ColorIndex = xlColorIndexNone
    
    ' 遍历每一行请求数据
    For j = 2 To lastReqRow
        hasMatch = False ' 默认标记为无匹配
        ' 如果请求行的所有测试列都为空，直接跳过
        If reqData(j, 8) = "" And reqData(j, 9) = "" And reqData(j, 10) = "" And _
           reqData(j, 11) = "" And reqData(j, 12) = "" And reqData(j, 13) = "" Then
            GoTo NextRequestRow
        End If
        
        ' 遍历每一行预约数据
        For i = 2 To lastApptRow
            ' 先检查Account#和日期是否匹配，不匹配直接跳过当前预约
            If reqData(j, 1) = apptData(i, 1) And reqData(j, 7) <= apptData(i, 12) Then
                ' 遍历H-M列（测试代码列）
                For col = 8 To 13
                    ' 检查测试代码是否非空且与预约类型匹配
                    If reqData(j, col) <> "" And reqData(j, col) = apptData(i, 16) Then
                        hasMatch = True ' 找到匹配，标记为有匹配
                        Exit For ' 跳出测试列循环
                    End If
                Next col
                If hasMatch Then Exit For ' 找到匹配，跳出预约行循环
            End If
        Next i
        
        ' 如果没有找到任何匹配，高亮为黄色（ColorIndex=6，可自行调整）
        If Not hasMatch Then
            wsReq.Rows(j).Interior.ColorIndex = 6
        End If
        
NextRequestRow:
    Next j
    
    ' 恢复Excel的默认设置
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    MsgBox "检查完成！", vbInformation
End Sub

三、关键优化点说明 #

1. 逻辑修正：

   • 新增hasMatch布尔变量，默认设为False（无匹配）；
   • 只有当找到任意一个符合条件的预约时，才将hasMatch设为True，并跳出所有内层循环；
   • 遍历完所有预约后，根据hasMatch的值决定是否高亮，避免中途错误标记。

2. 性能提升：

   • 使用数组reqData和apptData存储所有数据，将单元格访问次数从1000万次降到2次，大幅提升速度；
   • 动态获取最后一行数据，避免硬编码导致的无效循环；
   • 提前判断请求行是否全为空，直接跳过无意义的遍历；
   • 先检查Account#和日期这两个基础条件，不匹配的预约直接跳过，减少后续判断次数。

3. 可维护性优化：

   • 合并6个测试代码的判断逻辑为一个循环，后续新增测试代码只需调整列范围即可；
   • 代码结构更清晰，添加注释便于理解和修改。

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