Excel VBA优化：如何提升批量截取列单元格后四位的循环运行速度

原代码运行慢的核心原因 #

• 逐单元格选择、读写操作，每次和工作表交互都有很高的性能开销
• 没有关闭Excel默认的屏幕刷新、自动计算等功能，每一步修改都会触发界面重绘和公式重算，数据量越大卡顿越明显

优化方案（最高效版本） #

直接把整列数据加载到内存数组中处理，处理完成后一次性写回工作表，配合关闭不必要的Excel功能，提速可达百倍以上。
优化后代码如下：

Sub 截取A列最后四位()
    Dim lastRow As Long
    Dim dataArr As Variant
    Dim i As Long
    
    ' 临时关闭功能提升速度
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' 获取A列最后一个有数据的行号
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 仅当存在有效数据时运行
    If lastRow >= 2 Then
        ' 把A2到最后一行的所有数据读入数组
        dataArr = Range("A2:A" & lastRow).Value
        
        ' 遍历数组处理每一项
        For i = 1 To UBound(dataArr)
            If Not IsEmpty(dataArr(i, 1)) Then
                dataArr(i, 1) = Right(dataArr(i, 1), 4)
            End If
        Next i
        
        ' 把处理后的数组一次性写回工作表
        Range("A2:A" & lastRow).Value = dataArr
    End If
    
    ' 恢复原来的Excel设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

其他可选方案 #

如果不想写VBA，也可以用公式快速完成：

1. 在B2单元格输入公式 =RIGHT(A2,4)
2. 下拉公式到A列最后一行对应位置
3. 选中B列所有生成的结果，复制后右键A2单元格，选择「粘贴值」即可，处理完可以删除B列内容

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