Excel VBA中高效删除A列空白单元格所在行的优化方案咨询

针对1万+行数据删除A列空行慢的问题，下面是几种更高效的实现方案：

基础性能优化（通用所有VBA操作） #

先关闭Excel后台耗时功能，执行完再恢复，这能大幅提升原有代码的运行速度：

Sub DeleteBlankRowsBasicOpt()
    Dim ws As Worksheet
    Set ws = ActiveSheet '可指定具体工作表，如ThisWorkbook.Worksheets("Sheet1")
    
    '关闭耗时功能
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    On Error Resume Next '防止无空行时报错
    ws.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    '恢复功能
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

方案一：使用AutoFilter批量删除（推荐，代码简洁高效） #

利用筛选功能定位空行后批量删除，比SpecialCells更高效，尤其适合大数据量场景：

Sub DeleteBlankRowsWithFilter()
    Dim ws As Worksheet
    Dim lastRow As Long
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    '关闭耗时功能
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    '取消已有筛选
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    '筛选A列空值
    ws.Range("A1:A" & lastRow).AutoFilter Field:=1, Criteria1:=""
    
    '删除筛选出的行（跳过表头）
    On Error Resume Next
    ws.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    On Error GoTo 0
    
    '取消筛选
    ws.AutoFilterMode = False
    
    '恢复功能
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

注：若表头不是第一行，调整代码中ws.Range("A2:A" & lastRow)的起始行号即可。

方案二：数组遍历标记（超大数据量最优） #

将数据读入内存数组，遍历标记需删除的行后批量删除，内存操作远快于直接操作单元格：

Sub DeleteBlankRowsWithArray()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim arr As Variant
    Dim deleteRows As Range
    Dim i As Long
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    arr = ws.Range("A1:A" & lastRow).Value '读入数组
    
    '关闭耗时功能
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    '遍历数组，标记空行
    For i = 2 To lastRow '跳过表头
        If arr(i, 1) = "" Then
            If deleteRows Is Nothing Then
                Set deleteRows = ws.Rows(i)
            Else
                Set deleteRows = Union(deleteRows, ws.Rows(i))
            End If
        End If
    Next i
    
    '批量删除标记行
    If Not deleteRows Is Nothing Then deleteRows.Delete
    
    '恢复功能
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

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