- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2025-1-10
|
28#
發表於 2021-7-5 08:19
| 只看該作者
回復 27# wang077
我也是新手學習中,寫得不好請見諒,謝謝。
Sub 選擇檔案()
Dim Arr, WB, fc%, x%, fn$, n%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
With Sheets("總表")
If .FilterMode Then .ShowAllData '有篩選時解除篩選
.Range("a2:j" & .[a65536].End(3).Row) = "" '清除資料
With Application.FileDialog(msoFileDialogOpen) '選擇需求檔案
.InitialFileName = "D:\" '預設D槽
.AllowMultiSelect = True '可複選
.Show '畫面顯示
fc = .SelectedItems.Count '計算選擇檔案數
If fc = 0 Then Exit Sub '沒選檔案則離開
Tm = Timer '開始計時
For x = 1 To fc
FPath = .SelectedItems(x) '檔案路徑
Set WB = Workbooks.Open(FPath) '開啟檔案
With Sheets(1) '檔案的第1 sheet
If .FilterMode Then .ShowAllData '有篩選時解除篩選
Arr = .Range("a3:i" & .[a65536].End(3).Row) '來源裝入數組
fn = Split(ActiveWorkbook.Name, ".")(0) '取得檔名
End With
WB.Close '關閉來源檔案
n = [a65536].End(xlUp).Row + 1 '總表a欄最後一筆資料+1的位置
Range("a" & n).Resize(UBound(Arr), UBound(Arr, 2)) = Arr '來源貼入總表
Range("j" & n & ":j" & [a65536].End(xlUp).Row) = fn '來源的檔名貼入總表
Next
End With
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
MsgBox "執行完成" & Timer - Tm & " 秒"
End Sub |
|