- Sub test()
- Dim r%, i%
- Dim arr, brr(1 To 10000, 1 To 31)
- Dim mypath$, myname$
- Dim wb As Workbook
- Dim ws As Worksheet
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- vs = [{4,5,6,7,8,9,10,11,12,13,14,15,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36}]
- mypath = ThisWorkbook.Path & ""
- myname = Dir(mypath & "*.xlsx")
- m = 0
- Do While myname <> ""
- If myname <> ThisWorkbook.Name Then
- Set wb = GetObject(mypath & myname)
- Windows(wb.Name).Visible = True
- With wb
- With .Worksheets(1)
- c = .Cells(4, .Columns.Count).End(xlToLeft).Column
- r = .Cells(.Rows.Count, 1).End(xlUp).Row
- arr = .Range("a1").Resize(r, c)
- For j = 4 To UBound(arr, 2)
- m = m + 1
- For i = 1 To UBound(vs)
- brr(m, i) = arr(vs(i), j)
- Next
- Next
- End With
- .Close False
- End With
- End If
- myname = Dir()
- Loop
- With Worksheets("实现形式")
- .UsedRange.Offset(1, 0).ClearContents
- .Range("b2").Resize(UBound(brr), UBound(brr, 2)) = brr
- End With
-
- End Sub
复制代码 |