Excel VBA日期列过滤报错及打印/复制异常求助

问题根源分析 #

1. 1004错误原因：原代码获取lastRow的逻辑错误，过滤后可见区域为不连续多行时，SpecialCells(xlCellTypeVisible)返回的是多区域集合，直接访问.EntireRow.Row仅能返回第一个区域的行号，且逻辑不当会触发"未找到单元格"错误。
2. 打印空行与计数误解：
   • 原代码中visibleRows = filterRange.Rows.SpecialCells(xlCellTypeVisible).Count - 1计算的是可见单元格总数，而非行数，Debug.Print显示的37是单元格数量，不是实际过滤后的行数。
   • 日期过滤用字符串拼接DATE()函数存在格式风险（如月份/日期为个位数时的兼容性问题），可能导致过滤逻辑未正确匹配数据。
   • 直接打印包含表头的可见区域时，不连续区域会自动分页，视觉上出现空行。

修正后的完整代码 #

Public Sub FilterAndWriteData()
    Dim srcSheet As Worksheet
    Dim destSheet As Worksheet
    Dim filterRange As Range
    Dim dateColumnIndex As Long
    Dim statusColumnIndex As Long
    Dim visibleDataRange As Range
    
    ' 处理目标工作表
    On Error Resume Next
    Set destSheet = ThisWorkbook.Worksheets("FilteredSheet")
    On Error GoTo 0
    If destSheet Is Nothing Then
        Set destSheet = ThisWorkbook.Worksheets.Add
        destSheet.Name = "FilteredSheet"
    End If
    
    ' 设置源工作表
    Set srcSheet = ThisWorkbook.Worksheets("Sheet1")
    
    ' 查找列索引
    dateColumnIndex = srcSheet.Rows(1).Find(What:="Load Date", LookIn:=xlValues, LookAt:=xlWhole).Column
    statusColumnIndex = srcSheet.Rows(1).Find(What:="Final Status", LookIn:=xlValues, LookAt:=xlWhole).Column
    
    ' 清空目标表
    destSheet.UsedRange.Clear
    
    ' 设置过滤区域（包含表头）
    Set filterRange = srcSheet.Range("A1").CurrentRegion
    
    ' 移除已有过滤（避免残留规则影响）
    If srcSheet.AutoFilterMode Then srcSheet.AutoFilterMode = False
    
    ' 应用过滤规则
    With filterRange
        ' 日期过滤：直接用日期值，避免字符串拼接的格式问题
        If Weekday(Date, vbMonday) = 1 Then ' 用vbMonday确保周一为一周第一天，不受系统区域设置影响
            .AutoFilter Field:=dateColumnIndex, Criteria1:=">=" & Date - 3, Operator:=xlAnd, Criteria2:="<=" & Date - 1
        Else
            .AutoFilter Field:=dateColumnIndex, Criteria1:="=" & Date - 1
        End If
        ' 状态过滤
        .AutoFilter Field:=statusColumnIndex, Criteria1:="LDP"
    End With
    
    ' 获取过滤后的数据区域（排除表头）
    On Error Resume Next
    Set visibleDataRange = filterRange.Offset(1).Resize(filterRange.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 处理过滤结果
    If Not visibleDataRange Is Nothing Then
        ' 复制到目标表
        visibleDataRange.Copy destSheet.Cells(1, 1)
        
        ' 打印过滤后的数据（仅数据，不含表头）
        visibleDataRange.PrintOut
        
        ' 打印实际行数（调试用）
        Debug.Print "过滤后实际行数：", visibleDataRange.Rows.Count
    Else
        MsgBox "未找到符合条件的数据！"
    End If
    
    ' 清除过滤
    srcSheet.AutoFilterMode = False
End Sub

关键修改说明 #

• 日期过滤优化：直接用Date - 3这类日期值作为过滤条件，替代字符串拼接DATE()函数，避免格式兼容问题；用Weekday(Date, vbMonday)确保周一判断不受系统区域设置影响。
• 可见区域处理：通过filterRange.Offset(1).Resize(filterRange.Rows.Count - 1)排除表头后再获取可见区域，同时添加错误捕获处理无数据的情况。
• 复制与打印逻辑：仅操作排除表头后的有效数据区域，确保复制和打印的都是目标内容，避免表头分页导致的空行问题。
• 前置过滤清除：添加过滤前清除已有规则的逻辑，避免残留过滤影响结果准确性。

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