按日期筛选行（最近7天）：VBA代码修改及同表删除问题

我来帮你搞定这个VBA的问题！先拆解你的两个核心需求：修复日期筛选逻辑以适配7天/15天范围，以及直接在当前工作表删除不符合条件的行（不用复制到其他表）。

一、先排查原代码的问题点 #

你原来的语句If TypeName(xVal) = "Date" And (xVal >= Date - 7) Then可能遇到的问题：

• TypeName(xVal)判断过于严格，若单元格日期存储为Variant/Date（VBA中常见的日期存储形式），或者单元格是文本格式的有效日期，这个判断会失效
• 若你是从上往下遍历删除行，会导致删除后行索引错乱，直接跳过部分记录

二、优化后的完整代码 #

下面的代码直接在当前工作表操作，支持自定义保留天数（7天/15天），且完全避免了行索引错乱的问题：

Sub DeleteOldRecords()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim daysToKeep As Integer
    Dim cellVal As Variant
    
    ' 👉 这里设置要保留的天数：改成15就是保留15天内的记录
    daysToKeep = 7
    
    ' 引用当前活动工作表，也可以指定具体表，比如Set ws = ThisWorkbook.Sheets("数据报表")
    Set ws = ActiveSheet
    
    ' 获取日期列的最后一行（假设日期在A列，按需改成你的列，比如"B"或数字2）
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 🚨 关键：从最后一行往上遍历，避免删除行后跳行
    For i = lastRow To 2 Step -1 ' 假设第1行是表头，从第2行开始检查
        cellVal = ws.Cells(i, "A").Value
        
        ' 先判断是否为有效日期，兼容日期格式和文本格式的有效日期
        If IsDate(cellVal) Then
            ' 保留「今日及过去daysToKeep天」的记录，不符合则删除
            If cellVal < Date - daysToKeep Then
                ws.Rows(i).Delete
            End If
        Else
            ' 可选：如果单元格不是有效日期，也删除的话就取消下面的注释
            ' ws.Rows(i).Delete
        End If
    Next i
    
    MsgBox "筛选完成！已删除不符合条件的记录", vbInformation
End Sub

三、关键细节说明 #

1. 日期判断优化：
   用IsDate(cellVal)替代TypeName，它能准确识别所有VBA认可的有效日期（包括单元格格式为日期、或文本格式的"2024/05/20"这类日期字符串）

2. 删除行的正确姿势：
   必须从最后一行往上遍历（Step -1），因为如果从上往下删，删除一行后下面的行会自动上移，导致后续的循环跳过一行记录

3. 灵活适配天数：
   只需要修改daysToKeep变量的值，改成15就能快速切换为保留15天内的记录

4. 指定工作表：
   如果你不想用当前活动工作表，把Set ws = ActiveSheet改成Set ws = ThisWorkbook.Sheets("你的工作表名称")，避免误操作其他表

四、额外排查建议 #

如果代码运行后还是有问题，检查这两点：

• 确认日期列的位置：代码里默认是A列，要改成你实际存储日期的列（比如"B"对应第2列）
• 检查单元格格式：如果是文本格式的日期，确保是VBA能识别的格式（比如"yyyy/mm/dd"或"mm/dd/yyyy"）

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