试一下:- Sub test()
- Dim Dic, Wb As Workbook, Ws As Worksheet, Arr, Arrt(), n&, FN$, Str$, Rng As Range, R As Range, Str2$, x%
- Set Dic = CreateObject("scripting.dictionary")
- Application.ScreenUpdating = False
- FN = Dir(ThisWorkbook.Path & "\*.xls*")
- Do While FN <> ""
- If FN <> ThisWorkbook.Name Then
- Set Wb = GetObject(ThisWorkbook.Path & "" & FN)
- With Wb
- For Each Ws In .Worksheets
- With Ws
- n = .Cells(.Rows.Count, 1).End(xlUp).Row
- Arr = .Range("A1:C" & n)
- For i = 3 To n
- If Arr(i, 2) >= 80 And Arr(i, 3) >= 80 Then
- x = x + 1
- ReDim Preserve Arrt(1 To 6, 1 To x)
- Arrt(1, x) = Replace(FN, ".xls", "")
- Arrt(2, x) = Ws.Name
- Arrt(3, x) = i
- Arrt(4, x) = Arr(i, 1)
- Arrt(5, x) = Arr(i, 2)
- Arrt(6, x) = Arr(i, 3)
- End If
- Next
- End With
- Next Ws
- End With
- Wb.Close False
- End If
- FN = Dir
- Loop
- Sheet1.Range("A2").Resize(x, 6) = Application.WorksheetFunction.Transpose(Arrt)
- Set Wb = Nothing
- Application.ScreenUpdating = True
- Set Dic = Nothing
- End Sub
复制代码 |