VBA日期筛选问题：如何按距今日特定天数筛选保留记录

Let's break down what went wrong with your code and build a flexible solution that adapts to your needs (whether you need to keep 1 day, 3 days, or any number of days).

What Was Wrong With Your Original Modified Code #

When you tried to concatenate multiple dates with &, you ended up passing a single messy string like "<>452344523345232" to Criteria1. Excel's AutoFilter can't parse that as multiple exclusion rules—it just treats it as one invalid criteria, which is why you ended up deleting all records instead of keeping the ones you wanted.

Core Approach #

Your goal is to:

1. Identify the dates you want to keep (e.g., previous 3 days on Monday, previous 1 day on other weekdays)
2. Filter out all records that don't match those dates
3. Delete the filtered (unwanted) rows, leaving only the records you need

Reusable VBA Code #

Here's a flexible subroutine that lets you specify how many days of records you want to keep, and handles the filtering/deletion correctly:

Sub KeepRecentDaysRecords(ByVal dateColumn As Integer, ByVal daysToKeep As Integer)
    Dim targetSheet As Worksheet
    Dim keepDates() As Variant
    Dim i As Integer
    
    ' Set your target worksheet (update this to match your sheet name if needed)
    Set targetSheet = ThisWorkbook.Worksheets("YourDataSheet")
    
    ' Clear any existing filters first
    If targetSheet.AutoFilterMode Then targetSheet.AutoFilterMode = False
    
    ' Build an array of the dates we want to keep (converted to Excel's serial number format)
    ReDim keepDates(1 To daysToKeep)
    For i = 1 To daysToKeep
        keepDates(i) = CLng(DateAdd("d", -i, Date))
    Next i
    
    ' Filter to show only the dates we want to keep
    targetSheet.Columns(dateColumn).AutoFilter Field:=1, Criteria1:=keepDates, Operator:=xlFilterValues
    
    ' Delete all rows that are NOT the dates we want (skip header row, assuming it's row 1)
    On Error Resume Next ' Prevent error if no rows match the filter (unlikely, but safe)
    targetSheet.Range(targetSheet.Rows(2), targetSheet.Rows(targetSheet.Cells(targetSheet.Rows.Count, dateColumn).End(xlUp).Row)) _
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    On Error GoTo 0
    
    ' Remove the filter when done
    targetSheet.AutoFilterMode = False
End Sub

How to Use This Code #

• For regular weekdays (when you only need to keep the previous day's records):

  ' Replace 3 with your actual date column number
  KeepRecentDaysRecords dateColumn:=3, daysToKeep:=1
  

• For Mondays (when you need to keep Friday, Saturday, Sunday's records):

  KeepRecentDaysRecords dateColumn:=3, daysToKeep:=3
  

Auto-Adjust Based on Day of Week #

To make this fully automated (no manual input needed), add a wrapper that checks the current day and sets the number of days to keep automatically:

Sub AutoKeepRecords(ByVal dateColumn As Integer)
    Dim daysToKeep As Integer
    
    ' Use vbMonday to make Monday = 1, Tuesday = 2, ..., Sunday = 7
    Select Case Weekday(Date, vbMonday)
        Case 1 ' Monday
            daysToKeep = 3
        Case Else ' All other weekdays
            daysToKeep = 1
    End Select
    
    KeepRecentDaysRecords dateColumn, daysToKeep
End Sub

Key Notes #

• Make sure your date column uses numeric dates (not text-formatted dates). The CLng() conversion relies on Excel's internal date serial numbers.
• Always back up your data before running deletion macros—better safe than sorry!
• If your header row isn't row 1, update the targetSheet.Rows(2) part to match your actual first data row.

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