|
Sub 筛选数据()
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
With Sheets("sheet1")
r = .Cells(Rows.Count, 1).End(xlUp).Row
y = .Cells(1, Columns.Count).End(xlToLeft).Column
ar = .Range(.Cells(1, 1), .Cells(r, y))
End With
Dim br()
ReDim br(1 To 10000, 1 To 4)
With ActiveSheet
rq = .[a3]
If rq = "" Then MsgBox "请输入查询日期": End
If Not IsDate(rq) Then MsgBox "您输入的不是日期格式!": End
For j = 5 To UBound(ar, 2)
w = 0
If ar(1, j) <> "" Then
For i = 2 To UBound(ar)
If ar(i, j) <> "" Then
If IsDate(ar(i, j)) Then
If ar(i, j) = rq Then
w = w + 1
n = n + 1
If w = 1 Then br(n, 1) = ar(1, j)
For s = 1 To 3
br(n, s + 1) = ar(i, s)
Next s
End If
End If
End If
Next i
End If
Next j
If n = "" Then MsgBox "没有需要查询的数据!": End
.UsedRange.Offset(3) = Empty
.[a4].Resize(n, UBound(br, 2)) = br
End With
MsgBox "ok!"
End Sub
|
|