Excel VBAでフォルダ内の全テキストファイルの任意データを取得について

検索して、詳しい人が作成した以下のマクロをみつけて、これを使わせていただこうと思ったのですが、
この例だと、指定したフォルダー内の複数あるテキストファイルから、データを取得する際に、見本は見出しとデータが1行分だけで、その2行目のデータのみを取得しています。
私はテキストデータの１０行めから、７行ずつ取得したいのですが、このVBAの変更方法がわかりません。
詳しい方に教えていただきたく、どうかよろしくお願いいたします。

'指定フォルダの全テキストの任意行を取得
Sub GetAllTextData()

'フォルダ指定用のダイアログを表示します
With Application.FileDialog(msoFileDialogFolderPicker)

'カレントディレクトリを指定します
.InitialFileName = ThisWorkbook.Path

'設定しなかったら終了します
If .Show = False Then Exit Sub

'設定したフォルダを表示します
Dim Fname
Fname = .SelectedItems(1)

End With

'参照設定
Dim FSO As Object, Folder As Variant, File As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")

Dim FilePath As Variant
ReDim FilePath(1 To 100) As Variant

'指定フォルダ内の.txtファイルを探索します
i = 0
For Each File In FSO.GetFolder(Fname).Files
If InStr(File.Name, ".txt") > 0 Then
i = i + 1
FilePath(i) = File.Path 'ファイルのフルパスを取得
End If
Next

'配列の大きさは状況に応じ変更してください
Dim Hozon, GetData As Variant
ReDim GetData(1 To 100, 1 To 100) As Variant

'全テキストファイルの任意行のデータを取得する
m = 0
For k = 1 To UBound(FilePath, 1)

'テキストファイルが存在する場合に実行
If IsEmpty(FilePath(k)) = False Then

'保存する配列を空にする
ReDim Hozon(1 To 100, 1 To 100) As Variant

'テキストを開いて配列にデータを保存
Open FilePath(k) For Input As #1
i = 0
'テキストをすべて取得する
Do Until EOF(1)
Line Input #1, buf
i = i + 1
'コンマ区切りでデータを取得する
a = Split(buf, ",")
For j = 0 To UBound(a, 1)
Hozon(i, j + 1) = a(j)
Next
Loop
Close #1

'▼取得したいデータに応じ変更してください
'任意行の値を取得する
i = 2 '2行目のデータを取得
m = m + 1
For j = 1 To UBound(Hozon, 2)
GetData(m, j) = Hozon(i, j)
Next

End If
Next

'データ貼り付け
With ActiveSheet
.Range(.Cells(2, 1), .Cells(2, 1).Offset(UBound(GetData, 1) - 1, UBound(GetData, 2) - 1)) = GetData
End With

End Sub

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

• 補足させていただきます。
  テキストファイルは、10行目に
  「T1」,項目１,項目２,項目３,項目４,項目５,項目６,項目７,項目８,と40くらいまであります。この項目名と項目数はすべてのテキストファイルで同じです。
  11行目は、「T1」,10,55,45,85,62,44,33,20・・・・と項目ごとの数値がカンマ区切りで続きます。12行目も１１行目と同じです。
  テキストファイルの行数と列数はすべて同じで、１7行あり１７行めは「/」で終わります。
  今は、テキストファイルを１つずつ開いて、10行から16行をコピーして、Excelに貼り付け、区切り位置ウィザードで区切って使用しています。
  テキストファイルが４０くらいあることもあり、これがマクロでできれば本当に助かります。よろしくお願いいたします。m(__)m

  No.3の回答に寄せられた補足コメントです。 補足日時：2021/12/19 14:04

• いろいろ考えてくださり、ありがとうございます。
  出力先はSheet1です。項目の設定もおっしゃるとおりです。
  丁寧な資料を添付してくださり、ありがとうございます。

  No.4の回答に寄せられた補足コメントです。 補足日時：2021/12/20 17:35

No.7 ベストアンサー 回答者： tatsumaru77 回答日時： 2021/12/20 17:48

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

元のマクロの使える部分のみ流用しています。
Option Explicit

'指定フォルダの全テキストの任意行を取得
Sub GetAllTextData()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")

'フォルダ指定用のダイアログを表示します
With Application.FileDialog(msoFileDialogFolderPicker)

'カレントディレクトリを指定します
.InitialFileName = ThisWorkbook.Path

'設定しなかったら終了します
If .Show = False Then Exit Sub

'設定したフォルダを表示します
Dim Fname
Fname = .SelectedItems(1)

End With

'参照設定
Dim FSO As Object, Folder As Variant, File As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")

Dim FilePath As Variant
ReDim FilePath(100) As Variant

'指定フォルダ内の.txtファイルを探索します
Dim fcount As Long
fcount = 0
For Each File In FSO.GetFolder(Fname).Files
If Right(File.Name, 4) = ".txt" Then
FilePath(fcount) = File.Path 'ファイルのフルパスを取得
fcount = fcount + 1
End If
Next
ws.Cells.ClearContents
Dim i As Long
Dim line_no As Long
Dim wrow_st As Long
Dim wrow As Long
Dim buf As String
Dim elm As Variant
Dim no_elm As Long
'全テキストファイルの任意行のデータを取得する
For i = 0 To fcount - 1
wrow_st = 8 * i + 2
wrow = wrow_st
'テキストを開いて配列にデータを保存
Open FilePath(i) For Input As #1
line_no = 0
'テキストをすべて取得する
Do Until EOF(1)
Line Input #1, buf
line_no = line_no + 1
If line_no >= 10 And line_no <= 16 Then
'コンマ区切りでデータを取得する
elm = Split(buf, ",")
no_elm = UBound(elm) + 1
If line_no = 10 Then
ws.Cells(wrow, 1).Value = "テキストNo" & (i + 1)
End If
ws.Cells(wrow, 2).Resize(, no_elm).Value = elm
wrow = wrow + 1
End If
Loop
Close #1
Next
MsgBox ("完了")

End Sub

この回答へのお礼

できました。すごいです。
嬉しいで～す。
本当にありがとうございました。

お礼日時：2021/12/21 18:17

No.6 回答者： tatsumaru77 回答日時： 2021/12/19 17:12

No5です。

添付図をつけ忘れましたので添付します。

No.5 回答者： tatsumaru77 回答日時： 2021/12/19 17:11

Noです。

ファイルの処理順序ですが、エクスプローラで表示されている順番通りには処理されませんが宜しいでしょうか。
例えば、添付図には、data1.txt~data10.txtが表示されていますが、
data1.txt,data2.txt,data3.txt・・・data10.txt
の順番に処理されません。よろしいでしょうか。

No.4 回答者： tatsumaru77 回答日時： 2021/12/19 16:20

補足ありがとうございました。

出力先ですが、"Sheet1"へ以下のように設定します
１．A列は「テキストNo1」＋1からの連番　で良いですね。
（１０行目のみ）
２．B列は「T1」で良いですね。
３．C列、D列、E列は、項目１，項目２，項目３を設定します。以降の列も同様

上記でよろしいでしょうか。

No.3 回答者： tatsumaru77 回答日時： 2021/12/19 10:03

補足要求です。

１．今回のテキストファイルの実際の列は４列ということですか。
２．出力結果のA2に「テキストNo1」とありますが、これは固定文字ですか。(A10等も同様）
３．出力結果のB2,C2,D2,E2は、テキストファイルの1行目の1,2,3,4列の内容を設定するのですか。
それとも、商品名、色、値段、在庫数の固定文字ですか。
４．テキストファイルの10行目から７行取得する場合は、最低でも１６行必要になります。
全てのテキストファイルは１６行以上ありますか。

No.2 回答者： fujillin 回答日時： 2021/12/18 17:36

こんにちは

ご質問の文章では明示されていませんけれど、添付図を見ると
　・1列目にはファイル名を入れる
　・ファイルとファイルの間は1行分空行を入れる
みたない感じがしますけれど、そちらでよいでしょうか？

元のコードが全体の行数や項目数に限定が設けられていますけれど、それはそのままでよいものとして、部分修正でできる方法として、
　「'▼取得したいデータに応じ変更してください」
のところを以下のように変更すればできます。

GetData(m + 1, 1) = FSO.getfilename(FilePath(k)) ' ファイル名を追加
For i = 10 To 16 ' 取得する行数を設定
m = m + 1
For j = 1 To UBound(Hozon, 2) - 1
GetData(m, j + 1) = Hozon(i, j)
Next j
Next i
m = m + 1 ' ファイル間で1行分空ける

No.1 回答者： Qchan1962 回答日時： 2021/12/18 16:54

こんばんは

方法はいくつかありそうですが、、
ざっくりコードを読んだ感じ、GetData配列を作るところで
操作すれば良いと思います。

多分、該当部分

'▼取得したいデータに応じ変更してください
'任意行の値を取得する
i = 10 '2行目のデータを取得
While i < 17
m = m + 1
For j = 1 To UBound(Hozon, 2)
GetData(m, j) = Hozon(i, j)
Next
i = i + 1
Wend
End If
Next

'データ貼り付け

試していないのでステップ実行などでデバッグしてください。