[發問] 如何取出文字檔指定行的資料

luke

各位先進

執行目錄下有很多的資料夾, 若只想取出文字檔中的第1-3行資料, VBA該如何寫?
如附檔說明
TEST26.rar (114.25 KB)

下載次數: 4

2013-3-27 21:59

煩請先進指導, 謝謝!

GBKEE

回復 1# luke
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim S As Object, F As Object, AR, I As Integer
   
4.     Application.ScreenUpdating = False
   
5.                 'ScreenUpdating
   
6.     '如果螢幕更新功能是開啟的則為 True。讀/寫 Boolean。
   
7.     '關閉螢幕更新可加快巨集的執行速度。這樣將看不到巨集的執行程序，但巨集的執行速度加快了。
   
8.     '請注意，當巨集結束時，設定的ScreenUpdating 屬性會傳回 True。
   
9.    
   
10.     With CreateObject("Scripting.FileSystemObject").GETFolder(ThisWorkbook.Path)
    
11.                                 'FileSystemObject 物件 描述 提供對電腦檔案系統的存取。
    
12.         I = 2           '第二列開始
    
13.         For Each S In .SubFolders
    
14.                       'SubFolders 屬性 描述 傳回包含所有資料夾的一個 Folders 集合物件，這些資料夾包含在某個特定的資料夾中，包括設定了隱藏和系統檔屬性的那些資料夾。
    
15.             For Each F In S.Files
    
16.                            'Files 集合物件 描述  在一個資料夾內的所有 File 物件的集合物件。
    
17.                 With Workbooks.Open(F)
    
18.                      AR = .Sheets(1).[A1:A3]
    
19.                     .Close 0            '檔案關閉 不存檔
    
20.                 End With
    
21.                 '***Cells 沒指定工作表->作用中的工作表
    
22.                 Cells(I, "A") = S.Name  '資料夾名稱
    
23.                 Cells(I, "G").Resize(1, 3) = Application.WorksheetFunction.Transpose(AR)
    
24.                 'TRANSPOSE 語法   TRANSPOSE(array)
    
25.                 'Array    是工作表或巨集表中您所要轉置的矩陣。陣列的轉置是以 陣列的第一列作為新陣列的第一欄，而陣列的第 2 列則為新陣列的第 2 欄，依此類推。
    
26.                 I = I + 1 '第二列開始 往下加一列
    
27.             Next
    
28.         Next
    
29.         With Range("G:I") '***Range 沒指定工作表->作用中的工作表
    
30.             .Cells.Replace ";", "", LookAt:=xlPart       'Replace:替換字串
    
31.             .EntireColumn.AutoFit
    
32.         End With
    
33.     End With
    
34.     Application.ScreenUpdating= True
    
35.     '當巨集結束時，設定的ScreenUpdating 屬性會傳回 True。
    
36. End Sub

複製代碼

luke

回復 2# GBKEE

謝謝超版答覆

   當資料夾內有其他檔案格式如「0001112」資料夾有*.log或*.txt檔
   如何只篩選出csv檔如附件說明

下載 (20.57 KB)

2013-3-28 19:43

TEST26-1.rar (23.27 KB)

下載次數: 2

2013-3-28 19:43

GBKEE

回復 3# luke

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim S As Object, F As Object, AR, I As Integer
   
4.     Application.ScreenUpdating = False
   
5.                 'ScreenUpdating
   
6.     '如果螢幕更新功能是開啟的則為 True。讀/寫 Boolean。
   
7.     '關閉螢幕更新可加快巨集的執行速度。這樣將看不到巨集的執行程序，但巨集的執行速度加快了。
   
8.     '請注意，當巨集結束時，設定的ScreenUpdating 屬性會傳回 True。
   
9.     With CreateObject("Scripting.FileSystemObject").GETFolder(ThisWorkbook.Path)
   
10.                                 'FileSystemObject 物件 描述 提供對電腦檔案系統的存取。
    
11.         I = 2           '第二列開始
    
12.         For Each S In .SubFolders
    
13.                       'SubFolders 屬性 描述 傳回包含所有資料夾的一個 Folders 集合物件，這些資料夾包含在某個特定的資料夾中，包括設定了隱藏和系統檔屬性的那些資料夾。
    
14.             For Each F In S.Files
    
15.                            'Files 集合物件 描述  在一個資料夾內的所有 File 物件的集合物件。
    
16.                 If UCase(F) Like "*.CSV" Then  '檔名(大寫)有 "*.CSV"
    
17.                            'Like  運算子 用來比較兩個字串
    
18.                     With Workbooks.Open(F)
    
19.                          AR = .Sheets(1).[A1:A3]
    
20.                         .Close 0            '檔案關閉 不存檔
    
21.                     End With
    
22.                     '***Cells 沒指定工作表->作用中的工作表
    
23.                     Cells(I, "A") = S.Name  '資料夾名稱
    
24.                     Cells(I, "G").Resize(1, 3) = Application.WorksheetFunction.Transpose(AR)
    
25.                     'TRANSPOSE 語法   TRANSPOSE(array)
    
26.                     'Array    是工作表或巨集表中您所要轉置的矩陣。陣列的轉置是以 陣列的第一列作為新陣列的第一欄，而陣列的第 2 列則為新陣列的第 2 欄，依此類推。
    
27.                     I = I + 1 '第二列開始 往下加一列
    
28.                 End If
    
29.             Next
    
30.         Next
    
31.         With Range("G:I") '***Range 沒指定工作表->作用中的工作表
    
32.             .Cells.Replace ";", "", LookAt:=xlPart       'Replace:替換字串
    
33.             .EntireColumn.AutoFit
    
34.         End With
    
35.     End With
    
36.     Application.ScreenUpdating = True
    
37.     '當巨集結束時，設定的ScreenUpdating 屬性會傳回 True。
    
38. End Sub

複製代碼

luke

回復 4# GBKEE


    謝謝超版回覆

   假如取文字檔中非連續的第1行, 第3行和第5行
   應如何修改AR = .Sheets(1).[A1:A3]語法

GBKEE

回復 5# luke

1. Dim AR(1 To 3)
   
2.     ''
   
3.     ''
   
4.     ''
   
5.     AR(1) = .Sheets(1).[A1]
   
6.     AR(2) = .Sheets(1).[A3]
   
7.     AR(3) = .Sheets(1).[A5]

複製代碼