让我们一步步拆解你遇到的问题，然后给出修正后的代码：

你当前代码的核心问题 #

1. AutoFilter 条件语法错误
   你写的Criteria1:="=& myValue"是完全错误的字符串拼接方式，VBA里字符串和变量拼接要用&分隔，正确写法应该是"=" & myValue。但这还不够，直接用字符串匹配日期单元格可能会有格式兼容问题。

2. 数据类型不匹配
   你用String类型存储用户输入的日期，但Excel单元格里的日期本质是数值，直接用字符串匹配可能会因为区域设置的日期格式差异导致匹配失败，应该把输入的字符串转换成Date类型。

3. 筛选逻辑搞反了
   你的需求是保留指定日期的行+表头，删除其他所有行，所以应该筛选出不等于目标日期的行，然后删除这些行；而不是筛选等于目标日期的行再删除可见行（那样会把你要保留的行删掉）。

4. 最后一列计算错误
   原代码里LastCol = .Range("A" & .Columns.Count).End(xlToLeft).Column是错误的，这会去取A列最后一个单元格向左找的列，正确的做法是取第一行的最后一个单元格向左找：.Cells(1, .Columns.Count).End(xlToLeft).Column。

5. 删除行的范围引用错误
   你用的.Offset(1, 0).Resize(.Rows.Count).Rows.Delete会导致引用超出实际数据范围，应该改成.Offset(1, 0).Resize(.Rows.Count - 1).Rows.Delete，因为表头占了一行，实际数据从第2行开始，总行数要减1。

修正后的完整代码 #

Sub KeepSpecificDateOnly()
    Dim MySheet As Worksheet, MyRange As Range
    Dim LastRow As Long, LastCol As Long
    Dim myValue As String
    Dim targetDate As Date
    
    ' 关闭警告
    Application.DisplayAlerts = False
    ' 禁用屏幕刷新，提升运行速度
    Application.ScreenUpdating = False
    
    ' 指定工作表
    Set MySheet = ThisWorkbook.Worksheets("Sheet13")
    
    ' 获取用户输入的日期，并验证格式
    Do
        myValue = InputBox("Enter Date in XX/XX/XXXX Format", "Date Selection", "01/01/2024")
        ' 如果用户取消输入，退出宏
        If myValue = "" Then Exit Sub
        
        ' 尝试转换为日期类型，验证输入有效性
        On Error Resume Next
        targetDate = CDate(myValue)
        On Error GoTo 0
        
        ' 如果转换失败，提示用户重新输入
        If targetDate = 0 Then
            MsgBox "Invalid date format! Please enter a valid date in XX/XX/XXXX format.", vbExclamation
        End If
    Loop Until targetDate <> 0
    
    ' 写入测试用的日期（可选，可删除）
    MySheet.Range("Y1") = targetDate
    
    ' 获取数据区域的最后一行和最后一列
    With MySheet
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        ' 定义完整的数据区域（包含表头）
        Set MyRange = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
    End With
    
    ' 应用筛选：筛选出不等于目标日期的行
    With MyRange
        .AutoFilter Field:=1, Criteria1:="<>" & CDbl(targetDate), Operator:=xlFilterValues
        ' 删除筛选后的可见行（跳过表头）
        On Error Resume Next ' 处理没有符合条件的行的情况
        .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete
        On Error GoTo 0
    End With
    
    ' 关闭筛选
    With MySheet
        .AutoFilterMode = False
        If .FilterMode = True Then .ShowAllData
    End With
    
    ' 恢复警告和屏幕刷新
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Operation completed! Only rows with the specified date are retained.", vbInformation
End Sub

关键修改说明 #

• 日期验证：增加了循环验证用户输入的日期有效性，避免无效输入导致宏出错。
• 日期转换：把用户输入的字符串转换成Date类型，再用CDbl()转换成Excel识别的日期数值，确保匹配精准。
• 筛选逻辑：用"<>" & CDbl(targetDate)筛选出所有不等于目标日期的行，然后删除这些行，保留你需要的日期和表头。
• 错误处理：增加了On Error Resume Next处理没有可删除行的情况（比如所有行都是目标日期），避免宏报错。
• 性能优化：增加了Application.ScreenUpdating = False，减少屏幕闪烁，提升运行速度。

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