如何用Excel VBA删除DOB列不含1997/2001的行（保留首行）

以下是适配动态列数、可处理大规模数据的VBA宏，核心用Excel原生筛选功能提升效率，同时严格保留首行表头：

Sub KeepDOB1997And2001()
    Dim ws As Worksheet
    Dim dobCol As Range
    Dim lastRow As Long
    
    ' 指定操作工作表，可修改为具体表名如Sheets("数据")
    Set ws = ActiveSheet
    
    ' 关闭屏幕刷新加速处理
    Application.ScreenUpdating = False
    
    ' 自动定位DOB列表头
    Set dobCol = ws.Rows(1).Find(What:="DOB", LookIn:=xlValues, LookAt:=xlWhole)
    If dobCol Is Nothing Then
        MsgBox "未找到DOB列表头", vbExclamation
        Application.ScreenUpdating = True
        Exit Sub
    End If
    
    ' 获取数据最后一行行号
    lastRow = ws.Cells(ws.Rows.Count, dobCol.Column).End(xlUp).Row
    
    ' 清除已有筛选
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    ' 应用筛选：保留含1997或2001的行，兼容日期/文本格式
    ws.Range(dobCol, ws.Cells(lastRow, dobCol.Column)).AutoFilter _
        Field:=1, _
        Criteria1:="*1997*", _
        Operator:=xlOr, _
        Criteria2:="*2001*"
    
    ' 删除未被筛选的行（跳过首行）
    On Error Resume Next ' 无符合删除条件时避免报错
    ws.Range(ws.Rows(2), ws.Rows(lastRow)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    On Error GoTo 0
    
    ' 取消筛选
    ws.AutoFilterMode = False
    
    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
    
    MsgBox "处理完成", vbInformation
End Sub

核心细节说明 #

• 动态列适配：通过Rows(1).Find自动定位DOB列，无需手动指定列号，适配列数变化场景
• 大数据优化：用AutoFilter替代逐行循环，处理大规模数据时效率提升明显
• 首行保护：删除操作从第2行开始，确保表头不会被误删
• 容错处理：增加DOB列未找到的提示，以及无删除行时的错误捕获
• 格式兼容：通配符*匹配逻辑，同时支持日期格式（Excel日期转文本后含年份）和纯文本格式的DOB列

使用方法：打开Excel按Alt+F11进入VBA编辑器，插入模块后粘贴代码，返回工作表执行宏即可。

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