优化VBA代码：在For循环中忽略并排除空白行

原代码核心问题 #

1. 低效查找：循环调用VLOOKUP，每次遍历整列，数据量大时卡顿严重
2. 无效的空白行处理：原代码检查目标表C列空值，但该列始终为空，导致删除逻辑完全失效，输出大量空白行
3. 频繁Excel交互：逐单元格写入数据，IO开销大，拖慢运行速度

优化方案 #

1. 用字典实现O(1)快速查找 #

将RDS订单号存入字典，替代VLOOKUP，查找效率提升数十倍

2. 内存数组批量处理 #

所有数据读写在内存数组中完成，避免频繁操作Excel单元格

3. 直接生成无空白行结果 #

跳过“先写入所有行再删除空白”的冗余步骤，只收集符合条件的订单号，一次性连续写入目标表

优化后的完整代码 #

Sub btn_CheckCDMSsummary()
    Dim wsCDMS As Worksheet, wsRDS As Worksheet, wsTarget As Worksheet
    Dim arrCDMS As Variant, arrRDS As Variant
    Dim dictRDS As Object
    Dim lastRowCDMS As Long, lastRowRDS As Long
    Dim resultArr As Variant
    Dim i As Long, resultIndex As Long
    
    ' 关闭Excel耗时功能
    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .EnableEvents = False
    End With
    
    ' 缓存工作表对象，避免重复调用Sheets()
    Set wsCDMS = ThisWorkbook.Sheets("CDMS ORDER SUMMARY")
    Set wsRDS = ThisWorkbook.Sheets("RDS ORDER SUMMARY")
    Set wsTarget = ThisWorkbook.Sheets("NF CDMS TO RDS")
    Set dictRDS = CreateObject("Scripting.Dictionary")
    
    ' 初始化目标表
    wsTarget.Cells.Clear
    wsTarget.Cells(1, 1).Value = "Order No"
    wsTarget.Range("A:A").NumberFormat = "0"
    
    ' 读取RDS订单号到字典（快速去重+查找）
    lastRowRDS = wsRDS.Cells(wsRDS.Rows.Count, "A").End(xlUp).Row
    arrRDS = wsRDS.Range("A2:A" & lastRowRDS).Value
    For i = 1 To UBound(arrRDS)
        If Not IsEmpty(arrRDS(i, 1)) Then
            dictRDS(arrRDS(i, 1)) = True
        End If
    Next i
    
    ' 读取CDMS订单号到内存数组
    lastRowCDMS = wsCDMS.Cells(wsCDMS.Rows.Count, "B").End(xlUp).Row
    arrCDMS = wsCDMS.Range("B2:B" & lastRowCDMS).Value
    
    ' 初始化结果数组
    ReDim resultArr(1 To UBound(arrCDMS), 1 To 1)
    resultIndex = 0
    
    ' 批量筛选未同步订单
    For i = 1 To UBound(arrCDMS)
        If Not IsEmpty(arrCDMS(i, 1)) Then
            If Not dictRDS.Exists(arrCDMS(i, 1)) Then
                resultIndex = resultIndex + 1
                resultArr(resultIndex, 1) = arrCDMS(i, 1)
            End If
        End If
    Next i
    
    ' 将结果写入目标表（仅写入有数据的部分）
    If resultIndex > 0 Then
        wsTarget.Range("A2:A" & resultIndex + 1).Value = resultArr
    End If
    
    ' 恢复Excel功能
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    
    MsgBox "处理完成！共找到 " & resultIndex & " 条未同步订单", vbInformation
End Sub

优化效果说明 #

• 查找速度：字典查找替代VLOOKUP，数据量越大，提速效果越明显
• 运行效率：内存数组操作将IO次数从数百/数千次降到2次，大幅减少耗时
• 结果准确性：直接生成无空白行的连续数据，无需后续删除操作，彻底解决原代码的空白行问题

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