Sub 篩選全部數(shù)據(jù)()

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

'篩選區(qū)域寫入數(shù)組

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

? ??

? ??

'清除數(shù)據(jù)

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