マクロによるテキストファイルからの読み込み

現在下記内容のマクロの作成を考えています。

特定のフォルダにテキストファイルがまとめて入っています。
1枚目のシートのA1セルにテキストファイルのタイトルを入力すると
そのタイトルのテキストファイルを読み込み、その中から「勤務時間」という文字を探し出し
その勤務時間という文字の後に3行にわたって続く3つの数字を引っ張り出し、
2枚目のシートに3つ横並びで入力していく

という動きを想定しています。
テキストファイルは数字や文字が縦一列に並んでいます。

ご回答の程、よろしくお願いいたします。

質問者からの補足コメント

• No.1様
  
  勤務時間
  １
  ２
  ３
  
  という形になっております。
  勤務時間という言葉のあとに必ず3行の数字が続く形になります。
  
  No.2様
  テキストファイルの拡張子は.txtとなっており
  タイトルという言い方に問題がありました。
  タイトルではなくテキストファイルのファイル名になります。
  テキストファイル内にはファイル名は記載されておりません。
  追加質問の件ですが””で区切られておらず
  ケース①となります。
  
  
  引き続き、よろしくお願いいたします。

    補足日時：2017/04/05 11:32

No.4 ベストアンサー 回答者： tatsu99 回答日時： 2017/04/05 12:15

以下のマクロを標準モジュールに登録してください。

1枚目のシートのシート名はSheet1とします。
2枚目のシートのシート名はSheet2とします。
シート名が異なる場合は、あなたの環境に合わせてください。
Const folder As String = "d:\goo\excel\goo177"
は、テキストファイルが格納されているフォルダです。あなたの環境に合わせてください。

-------------------------------------
Option Explicit


Public Sub 勤務時間データ取得()
Const folder As String = "d:\goo\excel\goo177"
Dim inline As String
Dim fpath As String
Dim flg As Boolean
Dim col As Long
fpath = folder & "\" & Worksheets("Sheet1").Cells(1, "A").Value & ".txt"
If Dir(fpath) = "" Then
MsgBox (fpath & "は存在しません")
Exit Sub
End If
Open fpath For Input As #1
col = 1
flg = False
Do Until EOF(1)
Line Input #1, inline
If flg = True And col < 4 Then
Worksheets("Sheet2").Cells(1, col).Value = inline
col = col + 1
End If
If InStr(inline, "勤務時間") > 0 Then flg = True
Loop
Close #1
If flg = False Then
MsgBox ("勤務時間なし")
Else
MsgBox ("完了")
End If
End Sub
--------------------------------------

この回答へのお礼

早速試してみました。
思ったとおりの動作を確認できました。

これから内容を読み解いていこうと思います。
本当にありがとうございました。

お礼日時：2017/04/05 13:07

No.3 回答者： tatsu99 回答日時： 2017/04/05 11:28

追加質問です。

個々のデータは""でくくられていますか。くくられていませんか。
ケース①
勤務時間
123
456

ケース②
"勤務時間"
"123"
"456"

①②のどちらでしょうか。

No.2 回答者： tatsu99 回答日時： 2017/04/05 11:06

テキストファイルの拡張子はなんでしょうか。

.txtですか。.csvですか。
テキストファイル中のタイトルはどこに格納されていますか。1行目がタイトルですか。

No.1 回答者： GooUserラック 回答日時： 2017/04/05 09:41

「縦一列に並んでいます」とは以下のようになっているのですか？

勤
務
時
間
1
2
3

それとも

勤務時間
123

でしょうか？