按日期和时间筛选Excel数据的VBA代码问题求助

需求梳理 #

你的数据工作表（Data）中日期和时间是分开的两列，需要按以下规则筛选：

• 11/08/2022：时间范围 00:30 ~ 23:30
• 11/09/2022：全天所有时间
• 11/10/2022：时间范围 00:00 ~ 14:00

原代码存在的问题 #

1. 数据类型错误：Excel日期时间是双精度浮点数，用Long类型存储会丢失精度
2. 筛选逻辑错误：仅针对单一列做值匹配，没有处理日期+时间的联合筛选逻辑
3. 不符合时段筛选需求：代码试图用值数组匹配，无法实现连续时间段的筛选

修正后的VBA代码 #

Option Explicit

Sub Filter_My_Data()
    Dim Data_sh As Worksheet
    Dim Output_sh As Worksheet
    
    ' 定义工作表对象（根据实际列号调整）
    Set Data_sh = ThisWorkbook.Sheets("Data")
    Set Output_sh = ThisWorkbook.Sheets("Output")
    
    ' 初始化输出表和关闭原有筛选
    Output_sh.UsedRange.Clear
    If Data_sh.AutoFilterMode Then Data_sh.AutoFilterMode = False
    
    With Data_sh.UsedRange
        ' 联合筛选：日期+时间的多条件组合
        .AutoFilter Field:=2, Criteria1:="=11/8/2022", Operator:=xlAnd, Criteria2:=">=00:30", Field:=3
        .AutoFilter Field:=2, Criteria1:="=11/8/2022", Operator:=xlAnd, Criteria2:="<=23:30", Field:=3, Operator:=xlOr
        .AutoFilter Field:=2, Criteria1:="=11/9/2022", Operator:=xlOr
        .AutoFilter Field:=2, Criteria1:="=11/10/2022", Operator:=xlAnd, Criteria2:="<=14:00", Field:=3
        
        ' 复制可见区域到输出表
        .SpecialCells(xlCellTypeVisible).Copy Output_sh.Range("A1")
    End With
    
    ' 关闭筛选
    Data_sh.AutoFilterMode = False
    MsgBox "数据已筛选并复制完成"
End Sub

代码说明 #

1. 列号调整：代码中Field:=2对应日期列，Field:=3对应时间列，根据你的实际数据列位置修改
2. 多条件逻辑：用xlOr组合三个日期的筛选规则，每个日期内用xlAnd绑定时间范围
3. 可见区域复制：只复制筛选后的可见单元格，避免复制整行空值
4. 格式兼容：如果你的日期格式不匹配文本，可改用DateSerial(2022,11,8)这种日期函数格式

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