冬物クリーニング最大49%OFFはコチラ

検索して、詳しい人が作成した以下のマクロをみつけて、これを使わせていただこうと思ったのですが、
この例だと、指定したフォルダー内の複数あるテキストファイルから、データを取得する際に、見本は見出しとデータが1行分だけで、その2行目のデータのみを取得しています。
私はテキストデータの10行めから、7行ずつ取得したいのですが、この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

「Excel VBAでフォルダ内の全テキス」の質問画像

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

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

    No.3の回答に寄せられた補足コメントです。 補足日時:2021/12/19 14:04
  • いろいろ考えてくださり、ありがとうございます。
    出力先はSheet1です。項目の設定もおっしゃるとおりです。
    丁寧な資料を添付してくださり、ありがとうございます。

    No.4の回答に寄せられた補足コメントです。 補足日時:2021/12/20 17:35
教えて!goo グレード

A 回答 (7件)

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


元のマクロの使える部分のみ流用しています。
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
    • good
    • 1
この回答へのお礼

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

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

No5です。

添付図をつけ忘れましたので添付します。
「Excel VBAでフォルダ内の全テキス」の回答画像6
    • good
    • 0

Noです。


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

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


出力先ですが、"Sheet1"へ以下のように設定します
1.A列は「テキストNo1」+1からの連番 で良いですね。
(10行目のみ)
2.B列は「T1」で良いですね。
3.C列、D列、E列は、項目1,項目2,項目3を設定します。以降の列も同様

上記でよろしいでしょうか。
この回答への補足あり
    • good
    • 0

補足要求です。


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

こんにちは



ご質問の文章では明示されていませんけれど、添付図を見ると
 ・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行分空ける
    • good
    • 0

こんばんは


方法はいくつかありそうですが、、
ざっくりコードを読んだ感じ、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

'データ貼り付け

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング