Excel VBA 带日期条件的AutoFilter返回空及过滤数据复制问题求助

初始代码筛选返回空的核心诱因 #

• 日期条件格式不兼容：AutoFilter对日期类条件的识别高度依赖传入值的格式，直接使用">=" & CDate(d1)的字符串拼接方式，在不同区域设置下会把斜杠、横杠分隔的日期字符串识别为普通文本，无法匹配单元格内存储的日期值，最终返回空结果。
• 变量类型存储偏差：原代码将日期值声明为Long类型存储，但通过.Value读取带时间精度的日期单元格时，返回的是带小数的双精度值，用Long存储会截断小时维度的数值，造成日期边界匹配失效。
• 通用兼容写法：直接使用单元格.Value2读取到的Long型日期序列值拼接条件字符串，即可完全规避区域设置带来的识别问题。

现有筛选代码的现存问题 #

• 核心需求缺失：代码完全没有实现「清空LNG_PORT_23_SG工作表A11及以下原有数据」的步骤，粘贴新数据前会和旧数据叠加冲突。
• With块作用范围绑定错误：原代码的With块对象是单行表头范围A1:AC1，块内执行的.SpecialCells(xlCellTypeVisible)仅针对这一行表头生效，根本不会识别下方整个数据区的可见单元格，直接导致复制的内容只有表头，没有实际筛选出的业务数据，是筛选结果复制不全的核心诱因。
• AutoFilter参数误用：三个日期筛选语句末尾传入的7对应常量xlFilterValues，是多值列表筛选的专用参数，日期大小比较场景下误传该参数，会意外将条件从数值比较模式切换为列表匹配模式，造成筛选逻辑失效。语句里的1 * date1属于无意义冗余转换，date1本身已是通过.Value2读取的Long型日期值，无需额外运算。
• 错误处理兜底不全：当前仅开启On Error Resume Next就直接获取可见单元格，若筛选结果为空，代码无任何提示，也会触发运行时错误。

修正后可直接运行的参考代码 #

Option Explicit
Sub FilterDates()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim date1 As Long, date2 As Long, date3 As Long
    Dim copyRange As Range
    
    ' 绑定对应工作表
    Set wsSource = ThisWorkbook.Sheets("LNG_PORTFOLIO_2023_SG_HIST")
    Set wsTarget = ThisWorkbook.Sheets("LNG_PORT_23_SG")
    
    ' 读取筛选条件值
    date1 = wsTarget.Range("A2").Value2
    date2 = wsTarget.Range("B2").Value2
    date3 = wsTarget.Range("E2").Value2
    
    ' 清空目标表A11及以下的原有数据
    wsTarget.Range("A11:" & wsTarget.Cells(wsTarget.Rows.Count, "AC").Address).ClearContents
    
    ' 清除源表已有筛选状态，避免旧条件叠加
    wsSource.AutoFilterMode = False
    
    ' 应用筛选条件
    With wsSource.Range("A1:AC1")
        .AutoFilter Field:=28, Criteria1:=">=" & date1
        .AutoFilter Field:=29, Criteria1:="<=" & date2
        .AutoFilter Field:=9, Criteria1:=">=" & date3
        .AutoFilter Field:=1, _
            Criteria1:=wsTarget.Range("C2").Value, _
            Operator:=xlOr, _
            Criteria2:=wsTarget.Range("C3").Value
    End With
    
    ' 跳过表头行获取可见数据
    On Error Resume Next
    Set copyRange = wsSource.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 存在匹配数据时执行粘贴
    If Not copyRange Is Nothing Then
        copyRange.Copy Destination:=wsTarget.Range("A11")
    Else
        MsgBox "当前筛选条件下无匹配数据"
    End If
End Sub

代码运行说明：

• 复制范围通过Offset(1)跳过源表第一行的表头，不会重复粘贴列头
• 清空操作覆盖到目标表AC列（和源表列范围匹配），避免残留旧数据
• 提前清除源表的筛选状态，不会出现新旧筛选条件叠加的问题

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