質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

1回答

1713閲覧

テキストファイルからExcelへの条件付き出力

cho

総合スコア23

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

1クリップ

投稿2018/07/25 05:25

編集2022/01/12 10:55

複数のテキストファイルが同一フォルダ内にあります。
記載内容はバラバラです。
hoge1.txt
hoge2.txt
hoge3.txt
...

このテキストファイルを下記のような条件でエクセルに出力したいと考えています。

ファイル名(hoge1.txt)を取得・出力
テキスト内から「Surname」という文字列を検索し、「Surname」の次の行(例;TANAKA)を取得・出力
テキスト内から「Middle name」という文字列を検索し、「Surname」の次の行を取得・出力
...
ファイル名(hoge2.txt)を取得・出力
テキスト内から「Surname」という文字列を検索し、「Surname」の次の行(例;TANAKA)を取得・出力
テキスト内から「Middle name」という文字列を検索し、「Middle name」の次の行(例:ABC)を取得・出力
...

出力のイメージは以下の通りです。
hoge1.txt
TANAKA
ABC
...
hoge2.txt
...

テキストエクセルにコピペして、関数で検索・出力を行っているのですが、
量が多くて困っています。
マクロがほとんど書けないので、ご教示いただければ幸いです。

よろしくお願いします。

ちなみに、1ファイル分の実行は以下のように組んでみました。
これを複数ファイルに出力セルを下にずらしながら適応していければよいかと考えています。

VBA

1Sub PasteFromCSV() 2 Const CSV_FILE = "C:\hoge1.txt" 3 Dim ReadWBk As Workbook 4 Dim WriteWBk As Workbook 5 Dim WriteSht As Worksheet 6 Dim Rng As Range 7 8 Set WriteWBk = ActiveWorkbook 9 Set WriteSht = WriteWBk.ActiveSheet 10 11 Set ReadWBk = Workbooks.Open(CSV_FILE) 12 13 'ここから 14 Dim ReadSht As Worksheet 15 Dim rngStart As Range '開始セル 16 Dim rngEnd As Range '終了セル 17 18 Set ReadSht = ReadWBk.Worksheets.Item(1) 19 20 Set rngStart = ReadSht.Range("A:A").Find("Surname") 21 Set rngEnd = ReadSht.Range("A:A").Find("Middle name") 22 23 Range(rngStart, rngEnd).Copy 24 'ここまでデータの取り方検討中 25 26 WriteSht.Range("B1").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False 27 28 ReadWBk.Close 29 30 Set ReadWBk = Nothing 31End Sub 32

対象のテキストファイルの内容の一例です。
hoge1.txt
219809
Surname
TANAKA
Middle name
AA
Given Name
hogehoge

※Surnemaなどキーとなる文字は全てのファイルに必ずしも含まれるわけではありません。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

i_sugiyama_tomo

2018/07/25 07:57

データを取得するテキストファイルはどのような内容になっていますでしょうか。
i_sugiyama_tomo

2018/07/25 08:33

出力ですが、EXCELの1つのシートの1つの行に上から「ファイル名その1」「選別したデータ」「選別したデータ」・・・「ファイル名その2」「選別したデータ」「選別したデータ」・・・の順で各セルに入っていればいいでしょうか
cho

2018/07/25 08:34

はい、その通りです
guest

回答1

0

提示のコードを修正して、複数ファイルに対応させてみました。
特に解説はしませんので、不明点があれば質問をしてください。

VBA

1Sub PasteFromCSV() 2 Const CSV_FILE_DIR = "C:\" 3 Dim ReadWBk As Workbook 4 Dim ReadSht As Worksheet 5 Dim WriteWBk As Workbook 6 Dim WriteSht As Worksheet 7 Dim fn As String 8 Dim row_w As Integer 9 Dim row_r As Integer 10 11 Set WriteWBk = ActiveWorkbook 12 Set WriteSht = WriteWBk.ActiveSheet 13 14 fn = Dir(CSV_FILE_DIR & "hoge*.txt") 15 row_w = 1 16 Do While fn <> "" 17 18 WriteSht.Cells(row_w, 1) = fn 19 row_w = row_w + 1 20 21 Set ReadWBk = Workbooks.Open(CSV_FILE_DIR & fn) 22 Set ReadSht = ReadWBk.Worksheets.Item(1) 23 24 row_r = 1 25 Do While ReadSht.Cells(row_r, 1) <> "" 26 If ReadSht.Cells(row_r, 1) = "Surname" Or ReadSht.Cells(row_r, 1) = "Middle name" Then 27 row_r = row_r + 1 28 WriteSht.Cells(row_w, 1) = ReadSht.Cells(row_r, 1) 29 row_w = row_w + 1 30 End If 31 row_r = row_r + 1 32 Loop 33 34 ReadWBk.Close 35 36 Set ReadWBk = Nothing 37 38 fn = Dir() 39 Loop 40 41End Sub 42

投稿2018/07/26 02:29

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

cho

2018/07/26 02:49 編集

ありがとうございます。 早速試してみたのですが、ファイル名しか出力されず、テキスト内から「Surname」という文字列を検索し、「Surname」の次の行(例;TANAKA)を取得・出力が行えないようですが、確認いただけますでしょうか。 「Surname」の前後には不要な文字列が含まれてい場合があるので、おそらくそのせいで「Surname」の検索がヒットしないのだと思うのですが・・
ttyp03

2018/07/26 02:52

>確認いただけますでしょうか。 Teratailは質問者様が望むものを作ってあげるサービスではありません。 一応こちらでも動作を確認したものを回答しているつもりですが、環境の違いや質問に載っていない情報などで、希望するものとは異なる場合もあります。 正しく動かない場合は何が原因なのか、質問者様も一緒に考えていただけますか。 今回の場合では「Surname」という文字列を認識できていないようです。 「Surname」以外に余計な文字は付加されていないでしょうか?
ttyp03

2018/07/26 02:54

あ、かぶりました。 不要な文字列が含まれているということまでわかっているのであれば、それを考慮した判定にすればよいですね。
ttyp03

2018/07/26 02:56

判定処理を次のようにしてみてください。 If InStr(ReadSht.Cells(row_r, 1), "Surname") > 0 Or InStr(ReadSht.Cells(row_r, 1), "Middle name") > 0 Then
cho

2018/07/27 07:08

コメントへのご指摘、真摯に受け止めたいと思います。ありがとうござます。 いただいたコードを少し変更して実行したい形に近づいてきました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問