大量数据复杂筛选

tianyatai

首先判断B列的数据，如果大于10则AB两类数据复制到DE两列；如果B列的数据小于10，则需要判断这个数值前后两个大于10 的数值对应A列的时间差，如果时间差值小于120分钟，则将此行数值复制到DE两列

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, n, brr, t, num
  arr = [a1].CurrentRegion
  brr = arr: n = 1
  For i = 2 To UBound(arr, 1)
    num = arr(i, 2)
    If InStr(num, Space(1)) Then num = Val(Split(num)(0))
    If num > 10 Then
      n = n + 1
      brr(n, 1) = arr(i, 1): brr(n, 2) = arr(i, 2)
    Else
      For j = i - 1 To 2 Step -1
        num = arr(j, 2)
        If InStr(num, Space(1)) Then num = Val(Split(num)(0))
        If num > 10 Then t = arr(j, 1): Exit For
      Next
      If j > 1 Then
        For j = i + 1 To UBound(arr, 1)
          num = arr(j, 2)
          If InStr(num, Space(1)) Then num = Val(Split(num)(0))
          If num > 10 Then Exit For
        Next
        If j < UBound(arr, 1) + 1 Then
          If (arr(j, 1) - t) * 24 * 60 < 120 Then '分钟之差
            n = n + 1
            brr(n, 1) = arr(i, 1): brr(n, 2) = arr(i, 2)
          End If
        End If
      End If
    End If
  Next
  With [d1]
    .Resize(Rows.Count, 2).ClearContents
    .Resize(n, 2) = brr
  End With
End Sub

tianyatai

一把小刀闯天下 发表于 2018-7-22 11:52
Option Explicit

Sub test()

这个可不可以再加一个时间筛选，就是复制到DE列的数据行时间都是在每天的08:00-17:00之间的

tianyatai

一把小刀闯天下 发表于 2018-7-22 11:52
Option Explicit

Sub test()

再给看看吧

tianyatai

加一个时间筛选，就是复制到DE列的数据行时间都是在每天的08:00-17:00之间的

一把小刀闯天下

tianyatai 发表于 2018-7-22 15:27
加一个时间筛选，就是复制到DE列的数据行时间都是在每天的08:00-17:00之间的

'进入第一个循环后加入一个条件：

If CDate(Format(arr(i, 1), "hh:mm:ss")) >= #8:00:00 AM# And CDate(Format(arr(i, 1), "hh:mm:ss")) <= #5:00:00 PM# Then