VBA根据日期时间筛选数据

一、需求说明

    1、原始数据的A列为日期，B列为时间，现需要根据预先设定好的起止日期和起止时间，筛选出预设范围内的数据。

     2、预设条件

二、代码实现

三、实现效果

四、源代码

Sub CustomFilter()

    Dim Rng As Range, Arr As Variant

    Dim EndRow As Long, EndCol As Long

    Dim i As Long, j As Long

    Dim n As Long

    Dim StartDate, EndDate

    Dim BeginTime, EndTime

    Dim Brr() As String

    Dim StartTime As Variant

    Dim UsedTime As Variant

    StartTime = VBA.Timer

    '获取原始数据

    With Sheets('原始数据')

        '获取A列最后一行（非空行）的行号

        EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row

        '获取第一行最后一列（非空列）的列号

        EndCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column

        '保存数据

        Set Rng = .Range(.Cells(2, 1), .Cells(EndRow, EndCol))

        'Debug.Print Rng.Address

        '存入数组

        Arr = Rng.Value

    End With

    '获取时间设定

    With Sheets('筛选设定')

        StartDate = .Range('A2').Text

        EndDate = .Range('B2').Text

        BeginTime = .Range('A4').Text

        EndTime = .Range('B4').Text

    End With

    '循环筛选符合条件的数据

    '重新声明数组，用于保存筛选出来的数据

    ReDim Brr(1 To EndCol, 1 To 1)

    '初始化筛选结果的数量

    n = 0

    For i = LBound(Arr) To UBound(Arr)

        If DateDiff('d', CDate(StartDate), CDate(Arr(i, 1))) >= 0 And _

           DateDiff('d', CDate(Arr(i, 1)), CDate(EndDate)) >= 0 And _

           Arr(i, 2) >= TimeValue(BeginTime) And _

           Arr(i, 2) <= TimeValue(EndTime) Then

            '时间在 Arr=Rng.Value的时候已经自动转为TimeValue

            n = n 1

            ReDim Preserve Brr(1 To EndCol, 1 To n)

            For j = 1 To EndCol

                Brr(j, n) = Arr(i, j)

            Next j

        End If

    Next i

    '输出结果

    With Sheets('筛选数据')

        '清除首行标题以外的内容

        .UsedRange.Offset(1).ClearContents

        '设置筛选数据的输出区域

        Set Rng = .Range('A2')

        Set Rng = Rng.Resize(UBound(Brr, 2), UBound(Brr))

        '输出筛选结果

        Rng.Value = Application.WorksheetFunction.Transpose(Brr)

    End With

    Set Rng = Nothing

    UsedTime = VBA.Timer - StartTime

    MsgBox '本次运行耗时：' & Format(UsedTime, '#0.0000秒')

End Sub

五、欢迎打赏