Excel VBA按数组标识批量删行时触发Run-time 1004错误

报错根因 #

• 核心逻辑错位：Find 方法返回的是表头行中值为"CTM flag"的单个单元格对象，而非整个表头行。后续代码对这个单个单元格调用AutoFilter时，Excel自动推断的筛选区域完全不符合预期，且代码中硬编码Field:=2，完全没有对应到CTM flag实际所在的列，同时Offset(1,0)也是相对于单个CTM flag单元格偏移，而非相对于整个表头数据区偏移，最终导致筛选出的可见单元格范围完全错误。
• 1004错误直接触发点：当某一轮循环筛选后，SpecialCells(xlCellTypeVisible)返回空Range对象时，对空对象调用EntireRow.Delete就会抛出「Delete method of Range class failed」错误；此外旧筛选状态未清理时，多次设置AutoFilter的条件冲突也会触发该问题。
• 隐藏代码缺陷：
  • 未判断Find的返回值，若表头不存在"CTM flag"字段，对象b为Nothing，后续操作直接报错
  • 关闭筛选时引用了从未赋值的变量ws，运行时会触发对象未定义错误
  • 循环13次重复设置AutoFilter效率极低，且多次叠加筛选条件容易导致状态混乱
  • 用普通字符串"#N/A"筛选时，无法匹配公式返回的原生#N/A错误值单元格

可运行修正代码 #

' 模块顶部建议添加强制变量声明，避免隐式变量引发的未知bug
Option Explicit

Sub DeleteNonHET()
    ' 显式声明所有变量
    Dim FlagContent As Variant
    Dim Year_2M As String, Month_2M As String, MonthChar_2 As String
    Dim pStr As String, myFile As String, otherFile As String, sheet As String
    Dim wb As Workbook
    Dim Dataset As Workbook, MonthlyRepTool As Workbook
    Dim ws As Worksheet
    Dim filterRng As Range
    Dim lastRow As Long, ctmCol As Long
    Dim b As Range
    Dim delRng As Range
    
    ' 预设需要匹配删除的CTM flag取值
    ' 若#N/A为文本格式，将CVErr(xlErrNA)替换为"#N/A"即可
    FlagContent = Array("1", "2", "3", "4", "5", "8", "0", CVErr(xlErrNA), "G", "I", "J", "L", "M")
    
    ' 声明前推两个月的年份值，用于跨月度数据集比对
    Year_2M = Format(Date - 57, "YYYY")
    ' 声明前推两个月的月份数值，用于跨月度数据集比对
    Month_2M = Format(Date - 57, "MM")
    ' 将月份数值转换为月份名称字符格式
    MonthChar_2 = MonthName(Month_2M, False)
    
    ' 指定目标文件的存储路径
    pStr = "Z:\Danny Tool Test Folder\Monthly Files\" & Year_2M & "\" & _
    Month_2M & ". " & MonthChar_2 & " " & Year_2M & "\"
    myFile = "Dataset"
    otherFile = "Monthly Reporting Tool"
    sheet = "MASTERFILE_" & Year_2M & Month_2M
    
    ' 遍历已打开工作簿，匹配Dataset文件并赋值对象
    For Each wb In Application.Workbooks
        If wb.Name Like myFile & "*" Then
           Set Dataset = wb
        End If
    Next wb
    
    ' 遍历已打开工作簿，匹配Monthly Reporting Tool文件并赋值对象
    For Each wb In Application.Workbooks
        If wb.Name Like otherFile & "*" Then
           Set MonthlyRepTool = wb
        End If
    Next wb
    
    ' 异常判断：若未匹配到目标工作簿则退出
    If MonthlyRepTool Is Nothing Then
        MsgBox "未找到Monthly Reporting Tool工作簿，请检查后重试"
        Exit Sub
    End If
    
    ' 赋值目标工作表对象，避免重复书写长路径
    Set ws = MonthlyRepTool.Worksheets(sheet)
    
    ' 计算目标工作表A列的最后一行行号
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    If lastRow < 2 Then
        MsgBox "目标工作表无有效数据行"
        Exit Sub
    End If
    
    ' 清除原有筛选状态
    If ws.AutoFilterMode = True Then ws.AutoFilterMode = False
    
    ' 在表头行查找"CTM flag"字段的位置，全匹配避免误识别
    Set b = ws.Rows(1).Find(What:="CTM flag", LookIn:=xlValues, LookAt:=xlWhole)
    If b Is Nothing Then
        MsgBox "表头未找到CTM flag字段，请检查表头名称"
        Exit Sub
    End If
    ' 获取CTM flag所在的实际列号
    ctmCol = b.Column
    
    ' 定义全表数据筛选范围（覆盖所有列，从表头到最后一行数据）
    Dim lastCol As String
    lastCol = Split(Cells(1, ws.Columns.Count).Address, "$")(1)
    Set filterRng = ws.Range("A1:" & lastCol & lastRow)
    
    ' 一次性设置AutoFilter，匹配所有预设的删除取值
    filterRng.AutoFilter _
        Field:=ctmCol, _
        Criteria1:=FlagContent, _
        Operator:=xlFilterValues
    
    ' 获取除表头外的所有可见待删除行
    On Error Resume Next ' 捕获无可见匹配行的情况，避免空对象报错
    Set delRng = filterRng.Offset(1, 0).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 若存在待删除行则执行删除
    If Not delRng Is Nothing Then
        delRng.EntireRow.Delete
    End If
    
    ' 关闭工作表的筛选模式
    ws.AutoFilterMode = False

End Sub

代码修正点说明 #

• 所有工作表操作统一通过ws对象完成，解决了原代码中ws未定义的问题
• 通过b.Column动态获取CTM flag实际所在列号，不再硬编码筛选列序号，适配不同表头布局
• 采用一次性多值筛选的方式替代13次循环筛选，执行效率大幅提升，且避免多次设置筛选导致的状态冲突
• 增加全链路异常判断：未找到目标工作簿、未找到CTM flag表头、无有效数据时直接退出，避免空对象调用方法报错
• 对原生#N/A错误值采用CVErr(xlErrNA)处理，保证公式生成的错误值能被正确匹配
• 增加错误捕获逻辑，当无可见匹配行时跳过删除操作，避免空Range调用Delete触发1004错误
• Find操作增加LookAt:=xlWhole全匹配参数，避免误识别包含"CTM flag"文本的其他表头单元格

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