VBA日期对比异常：无法筛选早于2023/02/28的数据

你的代码出现所有数据都被复制的问题，核心原因是日期对比逻辑不可靠，大概率是以下两个问题导致：

• 单元格中的“日期”实际是文本格式，直接用<对比时是字符串比较而非日期比较；
• 使用CDate("28/02/2023")依赖系统区域设置，如果系统是美式日期格式（MM/DD/YYYY），这个字符串会被解析为无效日期，导致对比逻辑失效。

修正后的代码 #

Private Sub Macro1()
    Dim svsWs As Worksheet, summaryWs As Worksheet
    Dim lastRowSvs As Long, lastRowSummary As Long
    Dim i As Long
    Dim targetDate As Date
    
    ' 定义工作表对象，避免反复激活/选择
    Set svsWs = ThisWorkbook.Worksheets("SVS")
    Set summaryWs = ThisWorkbook.Worksheets("Summary")
    ' 用DateSerial创建目标日期，不受区域设置影响
    targetDate = DateSerial(2023, 2, 28)
    
    lastRowSvs = svsWs.Cells(svsWs.Rows.Count, 1).End(xlUp).Row
    
    For i = 3 To lastRowSvs
        ' 先判断单元格是否为日期，再转成日期类型对比
        If IsDate(svsWs.Cells(i, 22).Value) Then
            If CDate(svsWs.Cells(i, 22).Value) < targetDate Then
                lastRowSummary = summaryWs.Cells(summaryWs.Rows.Count, 1).End(xlUp).Row
                ' 直接复制行到目标位置，无需激活/选择
                svsWs.Rows(i).Copy Destination:=summaryWs.Cells(lastRowSummary + 1, 1)
            End If
        End If
    Next i
    
    Application.CutCopyMode = False
    svsWs.Cells(1, 1).Select
End Sub

关键优化点 #

• 用DateSerial创建日期：DateSerial(2023,2,28)直接生成指定日期，完全不受系统区域格式影响，避免解析错误；
• 先验证日期有效性：用IsDate判断单元格内容是否为可识别的日期，跳过无效数据；
• 避免Activate/Select：直接通过工作表对象操作，提升代码运行效率和稳定性；
• 明确变量类型：声明变量类型，避免变体类型带来的隐式转换问题。

额外高效方案（大数据量推荐） #

如果数据量较大，建议使用AutoFilter筛选代替循环，运行效率会显著提升：

Private Sub FilterDateWithAutoFilter()
    Dim svsWs As Worksheet, summaryWs As Worksheet
    Dim targetDate As Date
    
    Set svsWs = ThisWorkbook.Worksheets("SVS")
    Set summaryWs = ThisWorkbook.Worksheets("Summary")
    targetDate = DateSerial(2023, 2, 28)
    
    ' 清空Summary原有数据（保留表头的话调整范围）
    summaryWs.UsedRange.Offset(1).ClearContents
    
    ' 应用自动筛选
    svsWs.Range("A1:V" & svsWs.Cells(svsWs.Rows.Count, 1).End(xlUp).Row).AutoFilter _
        Field:=22, Criteria1:="<" & targetDate, Operator:=xlAnd
    
    ' 复制筛选后的可见行（跳过表头，从第3行开始）
    svsWs.Range("A3:V" & svsWs.Cells(svsWs.Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
        Destination:=summaryWs.Cells(summaryWs.Rows.Count, 1).End(xlUp).Offset(1)
    
    ' 取消筛选
    svsWs.AutoFilterMode = False
    Application.CutCopyMode = False
    svsWs.Cells(1, 1).Select
End Sub

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