Board logo

標題: [發問] 如何取出文字檔指定行的資料 [打印本頁]
作者: luke    時間: 2013-3-27 22:00     標題: 如何取出文字檔指定行的資料

各位先進

執行目錄下有很多的資料夾, 若只想取出文字檔中的第1-3行資料, VBA該如何寫?
如附檔說明
[attach]14470[/attach]

煩請先進指導, 謝謝!
作者: GBKEE    時間: 2013-3-28 16:24

回復 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    時間: 2013-3-28 19:44

回復 2# GBKEE

謝謝超版答覆

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

[attach]14477[/attach]
[attach]14478[/attach]
作者: GBKEE    時間: 2013-3-28 20:02

回復 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    時間: 2013-3-29 12:00

回復 4# GBKEE


    謝謝超版回覆

   假如取文字檔中非連續的第1行, 第3行和第5行
   應如何修改AR = .Sheets(1).[A1:A3]語法
作者: GBKEE    時間: 2013-3-29 12:09

回復 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]
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)