- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2023-9-21
|
2#
發表於 2022-8-23 13:03
| 只看該作者
DEAR ALL 大大
1.於 C:AAA\下放置 EXCEL檔 A1.XLS A2.XLS A3.XLS............
2.EXCEL 為 2010版 ...
rouber590324 發表於 2022-8-23 10:00 
請測試看看，謝謝
Sub test()
Dim Arr, a, fs, fc, f, f1, n&
Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False
Set fs = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "D:\"
.Title = "選擇檔案來源資料夾"
.Show
On Error GoTo EndSub:
a = .SelectedItems(1)
End With
Tm = Timer
Set f = fs.GetFolder(a)
Set fc = f.Files
For Each f1 In fc
Set WB = Workbooks.Open(f1)
With Sheets(1)
If .FilterMode Then .ShowAllData
Arr = .Range("a1").CurrentRegion
End With
WB.Close
If [a1] = "" Then n = 1 Else n = [A65536].End(xlUp).Row + 1
Range("a" & n).Resize(UBound(Arr), UBound(Arr, 2)) = Arr
Next
Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True
MsgBox "執行完成" & Timer - Tm & " 秒"
EndSub:
End Sub |
|
