如何用VBA删除Excel合并后的重复表头行？

问题背景 #

处理的MS Excel表格首行均为相同列表头，且表头已应用唯一筛选。现有一段VBA代码可单独处理各表格，实现列筛选、单元格高亮、排序等操作。但将多个表格数据（含表头）通过Ctrl+A复制粘贴合并到一个表格后，重复的表头行导致代码报错。目前只能手动删除除首行外的表头行，或复制时手动排除表头。

尝试了以下ChatGPT提供的VBA代码：

Sub DeleteFilteredRows()
    Dim ws As Worksheet
    Dim rng As Range
    Dim searchRange As Range
    Dim foundCell As Range
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Worksheets("special") ' Adjust the worksheet name
    
        ' Turn off filters to ensure proper deletion
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    Else
        MsgBox "No filters applied!", vbExclamation
        Exit Sub
    End If
    
    ' Define the range to search in (exclude the header row)
    Set searchRange = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    
    ' Find and delete rows containing "PARENT_NM"
    Set foundCell = searchRange.Find(What:="PARENT_NM", LookIn:=xlValues, LookAt:=xlWhole)
    
    Do While Not foundCell Is Nothing
        ws.Rows(foundCell.Row).Delete
        Set searchRange = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) ' Redefine search range
        Set foundCell = searchRange.Find(What:="PARENT_NM", LookIn:=xlValues, LookAt:=xlWhole)
    Loop
End Sub

运行时先提示No filters applied!，注释掉相关判断后，又在ws.Rows(foundCell.Row).Delete行触发run-time error '1004' Delete method of Range class failed错误。

原代码问题分析 #

1. 强制筛选检查：原代码要求工作表必须启用自动筛选，否则直接退出，不符合合并后表格可能无筛选的实际场景。
2. 逐行删除的缺陷：使用Find逐行删除时，删除行后后续行的索引会前移，导致Find方法可能漏查或引用错误行，进而触发1004错误。

修正后的VBA代码 #

Sub DeleteDuplicateHeaders()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim deleteRange As Range
    Dim i As Long
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Worksheets("special") ' 根据实际情况修改工作表名称
    
    ' 关闭自动筛选（如果存在），避免干扰
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    ' 获取数据区域最后一行行号
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 从下往上遍历，避免删除行导致的索引错乱
    For i = lastRow To 2 Step -1
        ' 检查当前行A列是否为表头关键字（这里用"PARENT_NM"作为表头标识）
        If ws.Cells(i, "A").Value = "PARENT_NM" Then
            ' 收集需要删除的行
            If deleteRange Is Nothing Then
                Set deleteRange = ws.Rows(i)
            Else
                Set deleteRange = Union(deleteRange, ws.Rows(i))
            End If
        End If
    Next i
    
    ' 一次性删除所有目标行
    If Not deleteRange Is Nothing Then
        deleteRange.Delete Shift:=xlUp
    End If
    
    MsgBox "重复表头行已删除完成", vbInformation
End Sub

代码关键说明 #

• 从下往上遍历：避免删除行后，后续行的索引发生变化导致漏删或错误引用。
• 批量删除：先收集所有需要删除的行，再一次性删除，比逐行删除效率更高，也能避免1004错误。
• 取消筛选强制退出：仅关闭筛选（如果存在），不强制要求工作表必须有筛选才能执行。
• 表头标识匹配：通过A列的"PARENT_NM"判断是否为重复表头，可根据实际表头关键字修改匹配条件。

内容的提问来源于stack exchange，提问作者Joshua van Niekerk