VBA-自动筛选符合条件的数据

1.效果图如下

2.我们可以看到符合条件---即入住日期刚好满7天的数据信息被筛选出来

3.代码如下

Option Explicit
Dim w0 As Workbook
Dim book0 As Worksheet
Dim book1 As Worksheet
Dim r0 As Range
Dim r1 As Range
Sub 自动筛选符合条件的信息()
Set w0 = ActiveWorkbook
Set book0 = w0.Worksheets("宿管信息")
Set book1 = w0.Worksheets("今日退宿名单")
Set r0 = book0.UsedRange
Set r1 = book1.UsedRange
Dim i As Long
Dim j As Integer
Dim indlenth As Integer
Dim aim()
Dim count2 As Long
Dim k As Long
book1.Cells.Clear
'将原始数据写入数组
Dim ori()
Dim needleave As Range
ori = r0
indlenth = 1
Do While indlenth <= UBound(ori, 2) - 1
If ori(1, indlenth) = "入住日期" Then Exit Do
indlenth = indlenth + 1
Loop
'将表头复制
r0.Resize(1, r0.Columns.count).Copy
    book1.Select
    Cells(1, 1).Select
    ActiveSheet.Paste
'判断是否属于需要退宿人员（满足条件）
k = 1
'运用公式将满足条件的数据条数计算出来
count2 = Application.WorksheetFunction.CountIf(r0.Resize(r0.Rows.count, 1).Offset(0, indlenth - 1), Date - 7)
ReDim aim(1 To count2, 1 To UBound(ori, 2))
For i = 2 To UBound(ori, 1)
Set needleave = r0.Resize(1, r0.Columns.count)
'将满足条件的信息明细赋值给目标数组
    If Date - CDate(ori(i, indlenth)) = 7 Then
               For j = 1 To UBound(ori, 2)
               aim(k, j) = ori(i, j)
               Next
        k = k + 1
    End If
Next
Dim finally As Range
Set finally = r1.Resize(count2, UBound(ori, 2)).Offset(1, 0)
finally = aim
If count2 > 0 Then
 MsgBox ("今天共" & count2 & "人需要退宿" & Chr(10) & "详情请看《今日退宿名单》")

Else
 MsgBox ("今天无人退宿！")
End If
End Sub