使用宏筛选今日及过往日期并删除未来日期行的问题求助

我来帮你排查下这个宏的问题，顺便给你一个更可靠的解决方案。先看看你原代码里的几个核心问题：

• 过度依赖Select和Activate操作单元格，这种写法很容易因为工作表选区变化导致宏崩溃，而且运行效率极低
• 筛选条件的语法错误，"<(NOW)"不是有效的VBA日期筛选写法，还重复设置了两次AutoFilter，逻辑混乱
• 完全没有实现删除未来日期行的核心逻辑，最后选到G228的操作毫无意义

下面是修正后的宏代码，逻辑是：筛选出F列中大于今日的日期行，直接删除这些行，剩下的就是今日及过往的日期行（包括逾期的）：

Sub KeepTodayAndPastDates()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim filterRange As Range
    
    ' 设置要操作的工作表，这里默认当前活动表，可改成Sheets("你的工作表名")
    Set ws = ActiveSheet
    
    ' 关闭屏幕更新，加快运行速度
    Application.ScreenUpdating = False
    
    ' 先移除之前的筛选（如果存在）
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    ' 获取F列最后一行的行号
    lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
    
    ' 定义筛选范围（包含表头，假设表头在第1行）
    Set filterRange = ws.Range("A1:F" & lastRow)
    
    ' 设置筛选：F列（Field:=6）大于今日日期
    filterRange.AutoFilter Field:=6, Criteria1:=">" & CLng(Date), Operator:=xlAnd
    
    On Error Resume Next ' 防止没有符合条件的行时触发错误
    ' 删除筛选出的可见行（跳过表头）
    filterRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    On Error GoTo 0 ' 恢复默认错误处理
    
    ' 移除筛选
    ws.AutoFilterMode = False
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    
    MsgBox "操作完成！已删除所有未来日期的行。"
End Sub

代码细节说明： #

• 直接操作工作表对象，彻底抛弃Select/Activate，宏的稳定性大幅提升
• 用Date函数获取当前日期（不带时间部分，完美适配纯日期格式的单元格），通过CLng(Date)转成数值，确保筛选条件能被Excel正确识别
• 先清除旧筛选再设置新条件，逻辑清晰不冲突
• 用SpecialCells(xlCellTypeVisible)精准选中筛选出的未来日期行，删除时自动跳过表头
• 加入屏幕更新开关，避免运行时的屏幕闪烁，同时提升运行速度

注意事项： #

1. 确保你的表格第1行是表头，F列是正确的日期格式
2. 如果数据不在当前活动工作表，把Set ws = ActiveSheet改成Set ws = Sheets("你的工作表名称")（比如Sheets("订单记录表")）

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