VBA实现M列指定范围空行删除 代码误删问题排查修正

需求说明 #

• 校验列：M列，校验起始行：M6
• 删除规则：若小计（Sub total）行下方的前两个M列单元格为空，则删除对应整行
• 本次案例目标：删除392-425行空行，最终效果参考下方结果截图

现存问题 #

原有VBA代码此前可正常运行，当前执行时出现严重误删：会清空校验范围内几乎所有内容，仅保留范围顶部5行。

模板结构规则 #

• 合并单元格规则：工作表内条目行使用合并单元格，单个合并行对应5个实际行高，例：截图中显示的1.1条目为2个合并行，对应10个实际行高
• 区块规则：模板默认单区块含3个合并行（共15个实际行）+末尾1个「Sub total」行，单区块总计17个实际行；实际录入时单区块可按需使用1/2/3个合并行，末尾固定保留「Sub total」行
• 保留边界：工作表最底部3行（Total、Submitted Invoices total、Difference）永久保留，可作为空行识别的下边界

原有问题代码 #

Option Explicit

Sub DeleteRows()

Const Col As String = "M"
Const fRow As Long = 13
Const mcCount As Long = 5

Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row

Dim cCell As Range
Dim r As Long

For r = fRow To lRow - mcCount
    'Debug.Print r
    Set cCell = ws.Cells(r, Col)
    If cCell.MergeArea.Cells.Count = mcCount Then
        If Len(CStr(cCell.Value)) = 0 Then
            cCell.Offset(-1).Resize(lRow - r + 1).EntireRow.Delete
            Exit For
        End If
        r = r + mcCount - 1
    End If
Next r

MsgBox "Rows deleted.", vbInformation

End Sub

误删原因 #

1. 起始校验行硬编码为13，和需求要求的M6起始位置不符
2. 未做Sub total行定位，遇到第一个空合并单元格就直接删除从该行上方到表尾的所有内容，既没有判断空行范围，也没有跳过底部需要永久保留的3行，必然出现大面积误删。

修复后可用代码 #

Option Explicit

Sub DeleteEmptyRowsBelowSubtotal()
    Const TARGET_COL As String = "M"
    Const START_ROW As Long = 6
    Const SINGLE_MERGE_ROWS As Long = 5
    Const KEEP_FOOTER_ROWS As Long = 3
    
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    ' 计算底部保留行的上边界，避免误删汇总行
    Dim lastCheckRow As Long
    lastCheckRow = ws.Cells(ws.Rows.Count, TARGET_COL).End(xlUp).Row - KEEP_FOOTER_ROWS
    
    Dim delStart As Long, currentRow As Long
    delStart = 0
    currentRow = START_ROW
    
    Do While currentRow <= lastCheckRow
        Dim currCell As Range
        Set currCell = ws.Cells(currentRow, TARGET_COL)
        
        ' 定位到Sub total行
        If InStr(1, CStr(currCell.Value), "Sub total", vbTextCompare) > 0 Then
            Dim nextCell As Range, secondCell As Range
            Set nextCell = ws.Cells(currentRow + 1, TARGET_COL)
            Set secondCell = ws.Cells(currentRow + 1 + SINGLE_MERGE_ROWS, TARGET_COL)
            
            ' 检查Sub total下方前两个合并单元格是否为空
            If Len(CStr(nextCell.Value)) = 0 And Len(CStr(secondCell.Value)) = 0 Then
                If delStart = 0 Then delStart = currentRow + 1
                ' 按合并行跨度向下跳转
                currentRow = currentRow + SINGLE_MERGE_ROWS
            Else
                ' 遇到非空内容，先删除之前累计的空行
                If delStart > 0 Then
                    ws.Rows(delStart & ":" & currentRow - 1).Delete
                    ' 修正删除行后的行号偏移
                    lastCheckRow = lastCheckRow - (currentRow - delStart)
                    currentRow = delStart
                    delStart = 0
                End If
                ' 按合并行跨度向下跳转
                If currCell.MergeArea.Count = SINGLE_MERGE_ROWS Then
                    currentRow = currentRow + SINGLE_MERGE_ROWS - 1
                End If
                currentRow = currentRow + 1
            End If
        Else
            ' 普通行按合并行跨度向下跳转
            If currCell.MergeArea.Count = SINGLE_MERGE_ROWS Then
                currentRow = currentRow + SINGLE_MERGE_ROWS - 1
            End If
            currentRow = currentRow + 1
        End If
    Loop
    
    ' 处理末尾剩余的待删除空行
    If delStart > 0 Then
        ws.Rows(delStart & ":" & lastCheckRow).Delete
    End If
    
    MsgBox "空行删除完成", vbInformation
End Sub

效果参考 #

• 删除前状态：
  
• 预期删除后效果：
  

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