- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
4#
發表於 2013-3-28 20:02
| 只看該作者
回復 3# luke - Option Explicit
- Sub Ex()
- Dim S As Object, F As Object, AR, I As Integer
- Application.ScreenUpdating = False
- 'ScreenUpdating
- '如果螢幕更新功能是開啟的則為 True。讀/寫 Boolean。
- '關閉螢幕更新可加快巨集的執行速度。這樣將看不到巨集的執行程序，但巨集的執行速度加快了。
- '請注意，當巨集結束時，設定的ScreenUpdating 屬性會傳回 True。
- With CreateObject("Scripting.FileSystemObject").GETFolder(ThisWorkbook.Path)
- 'FileSystemObject 物件 描述 提供對電腦檔案系統的存取。
- I = 2 '第二列開始
- For Each S In .SubFolders
- 'SubFolders 屬性 描述 傳回包含所有資料夾的一個 Folders 集合物件，這些資料夾包含在某個特定的資料夾中，包括設定了隱藏和系統檔屬性的那些資料夾。
- For Each F In S.Files
- 'Files 集合物件 描述 在一個資料夾內的所有 File 物件的集合物件。
- If UCase(F) Like "*.CSV" Then '檔名(大寫)有 "*.CSV"
- 'Like 運算子 用來比較兩個字串
- With Workbooks.Open(F)
- AR = .Sheets(1).[A1:A3]
- .Close 0 '檔案關閉 不存檔
- End With
- '***Cells 沒指定工作表->作用中的工作表
- Cells(I, "A") = S.Name '資料夾名稱
- Cells(I, "G").Resize(1, 3) = Application.WorksheetFunction.Transpose(AR)
- 'TRANSPOSE 語法 TRANSPOSE(array)
- 'Array 是工作表或巨集表中您所要轉置的矩陣。陣列的轉置是以 陣列的第一列作為新陣列的第一欄，而陣列的第 2 列則為新陣列的第 2 欄，依此類推。
- I = I + 1 '第二列開始 往下加一列
- End If
- Next
- Next
- With Range("G:I") '***Range 沒指定工作表->作用中的工作表
- .Cells.Replace ";", "", LookAt:=xlPart 'Replace:替換字串
- .EntireColumn.AutoFit
- End With
- End With
- Application.ScreenUpdating = True
- '當巨集結束時，設定的ScreenUpdating 屬性會傳回 True。
- End Sub
|
|
發表於 2013-3-27 22:00
| 
