批量数据场景下按条件复制列单元格的VBA代码优化求助

原代码逐个遍历单元格的方式，会频繁和Excel界面交互，处理数千条数据时会累积大量耗时；同时用文本判断#N/A的方式也不够可靠。以下是针对性的优化方案和代码：

优化思路 #

• 关闭Excel的屏幕更新、自动计算和事件触发，减少后台操作的性能消耗
• 将整列数据一次性读到内存数组中处理，数组操作比单元格交互快几个数量级
• 批量写入处理结果，大幅减少和Excel的交互次数
• 用IsError函数准确判断#N/A等错误值，替代易出问题的文本判断

优化后的代码 #

Sub CopyBPtoBE()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim bpData As Variant
    Dim beData As Variant
    Dim i As Long
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Sheets("ALL")
    
    ' 关闭Excel后台冗余操作，提升运行速度
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    On Error GoTo Cleanup ' 确保出错时恢复Excel默认设置
    
    ' 获取BP列最后一行数据行号
    lastRow = ws.Range("BP" & ws.Rows.Count).End(xlUp).Row
    If lastRow < 2 Then Exit Sub ' 若无有效数据直接退出
    
    ' 将BP列数据一次性读取到内存数组
    bpData = ws.Range("BP2:BP" & lastRow).Value
    ' 初始化BE列结果数组（和BP列数据尺寸一致）
    ReDim beData(1 To UBound(bpData, 1), 1 To 1)
    
    ' 在内存数组中遍历处理
    For i = 1 To UBound(bpData, 1)
        ' 跳过空值和错误值（#N/A属于错误值范畴）
        If Not IsEmpty(bpData(i, 1)) And Not IsError(bpData(i, 1)) Then
            beData(i, 1) = bpData(i, 1)
        End If
    Next i
    
    ' 批量将结果写入BE列
    ws.Range("BE2:BE" & lastRow).Value = beData

Cleanup:
    ' 恢复Excel默认设置
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    Set ws = Nothing
End Sub

优化说明 #

1. 后台操作管控：关闭屏幕更新后Excel不会实时刷新界面，手动计算避免每次写数据都触发全局重算，关闭事件触发防止其他宏或工作表事件干扰运行
2. 数组读写优化：把整列数据读到内存数组后循环判断，避免了原代码中数千次的单元格读写交互，速度提升显著
3. 错误判断准确性：IsError函数能直接识别单元格的错误类型（包括#N/A），比判断单元格文本更可靠，不会因格式或显示问题出现误判

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