|
本帖最后由 t502435282 于 2018-7-14 11:38 编辑
Sub 录入表汇总()
Dim arr()
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "请选择需汇总的文件夹"
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
Else
Path = .SelectedItems(1) & "\"
End If
End With
Application.ScreenUpdating = False '//关闭屏幕刷新
Application.DisplayAlerts = False '//关闭系统提示
t = Timer '//开始时间
Set Fso = CreateObject("Scripting.FileSystemObject")
Sheet1.Range("e2:ca" & Rows.Count).ClearContents
p = ThisWorkbook.Path & "\"
f = Dir(p, vbDirectory)
Do While f <> ""
If f <> "." And f <> ".." Then
If (GetAttr(p & f) And vbDirectory) = vbDirectory Then
m = m + 1
ReDim Preserve arr(m)
arr(m) = p & f & "\"
End If
End If
f = Dir
Loop
For j = 1 To m
f = Dir(arr(j) & "*.xls")
While f <> ""
Set wb = CreateObject(arr(j) & f)
With wb.Sheets(1)
ar = .[i3:i309]
End With
Sheet1.Cells(3, 5 + n).Resize(61) = ar
Sheet1.Cells(2, 5 + n) = Replace(Split(Split(f, ".")(0))(0), "接入工程", "")
n = n + 1
wb.Close False
f = Dir()
Wend
Next
Set wb = Nothing
Application.ScreenUpdating = True '//恢复屏幕刷新
Application.DisplayAlerts = True '//恢复系统提示
MsgBox "一共用时:" & Format(Timer - t, "#0.0000") & " 秒共汇总了 " & n & " 个文件"
End Sub
|
|