vba筛选数据

Sub 筛选全部数据()

Dim dic As Object

Dim arr()

Dim wb As Workbook

Application.ScreenUpdating = False

Application.DisplayAlerts = False

'激活TB表

    For Each wb In Workbooks

        s = wb.Name Like "*科目明细账&TB表*.xls*"

        If s = True Then

            wb.Activate

        End If

    Next

'筛选区域写入数组

Set dic = CreateObject("scripting.dictionary")

arr = Range("e12").CurrentRegion

'激活新表格

    For Each wb In Workbooks

        s = wb.Name Like "*对账*.xls*"

    If s = True Then

        wb.Activate

    End If

    Next

    

    

'清除数据

x = ActiveSheet.Range("a6").End(xlDown).Row

ActiveSheet.Range("a6:aa" & x).Clear

ActiveSheet.Range("5:5").AutoFilter

'写入表格

n = 6

    For i = 1 To UBound(arr, 1)

    

    

        If arr(i, 18) = ActiveSheet.Name Then '输入条件1，条件2,先找到所在的行

        

            For j = 1 To UBound(arr, 2)

            

                ActiveSheet.Cells(n, j) = arr(i, j) '再把所有列的信息一并粘贴再新表格里

            

            Next j

            

            n = n + 1

        End If

    Next i

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub