楼主
kevinchengcw |
Q: 如何利用vba代码根据单元格时间区间筛选出符合条件的数据？
A: 代码如下：
- Sub test()
- Dim Arr, Arr2, Result, N&, I&
- With Worksheets("Down") '将时间段区间数据装入数组
- Arr = .Range("B2:D" & .Cells(.Rows.Count, 2).End(3).Row).Value
- End With
- With Worksheets("alarm") '将筛选内容数据装入数组
- Arr2 = .Range("a2:k" & .Cells(.Rows.Count, 1).End(3).Row).Value
- End With
- ReDim Result(LBound(Arr) To UBound(Arr), 1 To 1) '重定义输出结果的数组
- For N = LBound(Arr) To UBound(Arr) '循环时间段区间数据
- For I = LBound(Arr2) To UBound(Arr2) '循环筛选内容数据
- If Val(Format(Arr2(I, 1), "yymmddhhmm")) >= Val(Format(Arr(N, 1), "yymmddhhmm")) And Val(Format(Arr2(I, 1), "yymmddhhmm")) <= Val(Format(Arr(N, 2), "yymmddhhmm")) Then '将时间段内容按年月日时分的方式重组为整数进行对比,如果符合时间段区间,则
- 'If CDbl(Arr2(I, 1)) >= CDbl(Arr(N, 1)) And CDbl(Arr2(I, 1)) <= CDbl(Arr(N, 2)) Then '本段直接将数据内容转换为双精度浮点数进行对比,包含秒的对比
- If Result(N, 1) = "" Then '如果结果数组对应项内无内容则写入当前筛选出的数据
- Result(N, 1) = Arr2(I, 11)
- Else '否则添加换行,写入当前筛选出的数据
- Result(N, 1) = Result(N, 1) & vbNewLine & Arr2(I, 11)
- End If
- End If
- Next I
- If Result(N, 1) = "" Then Result(N, 1) = "无" '如果未筛选到符合的结果,则置为"无"
- Next N
- With Worksheets("down") '向目标工作表写入结果
- Application.ScreenUpdating = False '关闭屏幕刷新,防止闪屏
- .Range("e2:e" & .Rows.Count).ClearContents '清空目标数据区
- .[e2].Resize(UBound(Result)) = Result '将结果写入目标数据区
- .Columns.AutoFit '列宽自适应
- .Rows.AutoFit '栏高自适应
- Application.ScreenUpdating = True '打开屏幕刷新
- End With
- End Sub
详见附件及素材源帖.
 demo.rar
|