|
- Sub test()
- Application.ScreenUpdating = False
- Set fo = CreateObject("scripting.filesystemobject")
- Set fd = fo.getfolder(ThisWorkbook.Path)
- x = Sheet1.[a1]
- y = Sheet1.[a5]
- n = 1
- ReDim arr(1 To 7, 1 To 1)
- For Each f In fd.Files
- If Val(f.Name) Then
- fn = Split(f.Name, ".")(0)
- Set w = Workbooks.Open(f)
- With Sheets(1)
- c = .Cells(x, 52).End(1).Column
- brr = .Range("a" & x, .Cells(y, c))
- For i = 1 To c
- If brr(1, i) = brr(UBound(brr) - 1, i) And brr(2, i) = brr(UBound(brr), i) Then
- arr(1, n) = brr(1, i)
- arr(2, n) = brr(2, i)
- arr(4, n) = brr(1, i)
- arr(5, n) = brr(2, i)
- arr(6, n) = fn
- arr(7, n) = Replace(.Cells(1, i).Address(0, 0), 1, "")
- n = n + 1
- ReDim Preserve arr(1 To 7, 1 To n)
- End If
- Next i
- End With
- w.Close False
- End If
- Next
- Sheet1.[b1].Resize(7, n) = arr
- Application.ScreenUpdating = True
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|