人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

VBAによるテキストファイルの処理についての質問です。

特定のフォルダ内にある全てのテキストファイルにおいて、特定のキーワードから
始まる複数行のデータを抽出するマクロをご教示ください。

例)
2015/3/10 23:30:05
?
==== DATA =====
--- DATA1 ---- ----DATA2---- ----DATA3---- ----DATA4----
2015/1/1 00:00 0.00 100 200 300 0.0 0% 0%
2015/1/1 00:10 0.00 100 200 300 0.0 0% 0%
?
2015/1/1 23:50 0.00 100 200 300 0.0 0% 0%

==== DATA2 ====
?


上記データが含まれるテキストファイル(改行LF)が複数あり、全てのテキスト
ファイルから==== DATA ===== から ==== DATA2 ===== までの間のデータ
だけを抽出し、1つのファイルに保存するマクロを作りたいのですが、
作り方をご教示ください。

キーワードからキーワードまででも良いですし、キーワードから決まった行数分
データを抽出するでもかまいません。

元ファイルがLF改行なので、その点も考慮頂きヒントを頂けますと幸いです。


以上、宜しくお願いします。


●質問者: buri0624
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● a-kuma3
●500ポイント ベストアンサー

こんな感じになると思います。

Sub extract_textdata()

 Open "D:\tmp\input.txt" For Input As #1
 Line Input #1, buf
 Close #1
 
 buf2 = Split(buf, vbLf)
 found = False

 Dim data() As String
 n = 0
 For Each Line In buf2
 If Line = "==== DATA2 ====" Then  ' 終了判定
 Exit For
 End If
 If found Then
 ReDim Preserve data(n)
 data(n) = Line
 n = n + 1
 End If
 If Line = "==== DATA =====" Then  ' 開始判定
 found = True
 End If
 Next

 Open "D:\tmp\output.txt" For Output As #1
 For Each Line In data
 Print #1, Line
 Next
 Close #1

End Sub

入力のデータを一気に読み込んでから Split 関数で分割しているので、元データが大きいと動かない可能性はあります。
とりあえず、1、2 万行くらいのデータであれば処理できるみたいですけれど。




追記です。

全てのテキストファイル、というのを、すっかり失念してました ><。
こんな感じになります。

Sub extract_textdata()

 Const targetFolder = "D:\tmp"  ' 対象のテキストファイル群があるフォルダ名
 Const outputFile = "D:\output\output.txt"  ' 出力ファイル名
 
 Set fs = CreateObject("Scripting.FileSystemObject")
 Set folder = fs.GetFolder(targetFolder)

 Open outputFile For Output As #2

 For Each f In folder.Files
 fname = folder.Path & "\" & f.Name
 Open fname For Input As #1
 Line Input #1, buf
 Close #1
 
 buf2 = Split(buf, vbLf)
 found = False

 Dim data() As String
 n = 0
 For Each Line In buf2
 If Line = "==== DATA2 ====" Then
 Exit For
 End If
 If found Then
 ReDim Preserve data(n)
 data(n) = Line
 n = n + 1
 End If
 If Line = "==== DATA =====" Then
 found = True
 End If
 Next

 For Each Line In data
 Print #2, Line
 Next

 Next

 Close #2

 Set fs = Nothing

End Sub

後、追加の質問で恐縮ですが、指定したキーワードから上下で何行まで
とかを指定することは可能でしょうか?
もしくは、開始キーワードからの行数指定での抽出方法があれば
ご教示下さい。

「上下」ってのは、ちょっと面倒なのですが、開始キーワードから行数指定であれば簡単です。
内側のループの脱出条件を、以下のように書き換えます。

 For Each Line In buf2
' If Line = "==== DATA2 ====" Then
' Exit For
' End If
 If n = 2 Then  ' 開始キーワードから 2行だけ出力する
 Exit For
 End If

buri0624さんのコメント
上下指定が出来ればベストですが、別で質問させて頂いた不要な行の削除 処理とあわせれば何とかできそうです。 素早い回答本当に助かります。どうも有難うございました。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ