求助大神按日期提取数据方法

xy5xin

有一些监测站的水位数据需要是每5分钟1次的，现在想按月为单位，每月提取一个数据，比方说每个站都提取6月10日早8点的数据、7月10日早8点的数据……以此类推，求助大神公式，万分感谢！！！

我是来讨说法的

筛选，输入
*-*-10 08:00

xy5xin

量有点大，很多站，能不能有批量筛选的方法

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.Offset(1).ClearContents
    For i = 2 To Sheets.Count
        arr = Sheets(i).UsedRange
        For j = 2 To UBound(arr)
        
            If Val(Day(arr(j, 2))) = 10 And Val(Hour(arr(j, 2))) = 8 And Val(Minute(arr(j, 2))) = 0 Then
                r = Cells(Rows.Count, 1).End(3).Row + 1
                Cells(r, 1) = arr(j, 1)
                Cells(r, 2) = arr(j, 2)
                Cells(r, 3) = arr(j, 3)
            End If
        Next j
    Next i
    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容供参考。。。。。。

xy5xin

liulang0808 发表于 2018-9-5 11:17
附件内容供参考。。。。。。

附件在哪，没找到- -

Chip_Kenny

簡單公式, 詳看附件:

liulang0808

上次因为附件太大导致无法上传，删除部分数据，供参考

simic1989

Sub text()
Dim i As Long, k As Integer, d As Integer, h As Integer, m As Integer
k = 2
For i = 2 To Range("b65536").End(xlUp).Row
d = Day(Range("b" & i))
h = Hour(Range("b" & i))
m = Minute(Range("b" & i))
    If d = 10 And h = 8 And m = 0 Then
    Range("a" & i).Copy Range("e" & k) '复制测站编号
    Range("b" & i).Copy Range("f" & k) '复制时间
    Range("g" & k) = Range("c" & i) '复制水位
    k = k + 1
    End If

Next
End Sub

xy5xin

Chip_Kenny 发表于 2018-9-5 11:47
簡單公式, 詳看附件:

非常感谢！！！！