|
Option Explicit
Sub test()
Dim ar, br, cr, i&, j&, r&, k&, n&, Items As FileDialogSelectedItems, vItem, strPath$
strPath = ThisWorkbook.Path & "\"
With Application.FileDialog(1)
With .Filters
.Clear
.Add "Excel Files", "*.xls"
End With
.AllowMultiSelect = True
.InitialFileName = strPath
If .Show Then Set Items = .SelectedItems Else Exit Sub
End With
Application.ScreenUpdating = False
ReDim ar(1 To 10 ^ 3, 1 To 16)
cr = [{1,1;2,6;3,14;5,18;9,54;16,58}]
For Each vItem In Items
With GetObject(vItem)
With .Worksheets(1)
n = .Cells(.Rows.Count, "B").End(xlUp).Row
With .Range("B1:CL" & n) '.Value
n = .Rows.Count
For i = 1 To n Step 21
br = .Cells(i, 1).Resize(21, .Columns.Count)
For k = 11 To 20
r = r + 1
For j = 1 To UBound(cr)
ar(r, cr(j, 1)) = br(k, cr(j, 2))
Next j
Next k
Next i
End With
End With
.Close False
End With
Next
[A1].CurrentRegion.Offset(2).ClearContents
[C3].Resize(r, UBound(ar, 2)) = ar
Set Items = Nothing
Application.ScreenUpdating = True
Beep
End Sub
|
评分
-
1
查看全部评分
-
|