エクセルの各シートに複数のテキストファイルを取り込むには？

質問

はじめまして。データの整理で困っています。
お力をお借りできたらと思います。

複数のテキストファイルがあります。
これらをエクセルのシートに取り込み、
各シート名を取り込んだファイル名としたいのですが、
何か良い方法はないでしょうか？
例えば、
No1_1001_1.txt、No1_1001_2.txt、No1_1002_1.txt、...
というファイル群を
Data_No1.xls のSheet1 <- No1_1001_1.txt
Data_No1.xls のSheet2 <- No1_1001_2.txt
Data_No1.xls のSheet3 <- No1_1001_3.txt
...
というようにしたいのですが。よろしくお願いします。

回答No.2

ham_kamo · ベストアンサー

マクロを作ってみました。もっとスマートなやり方があるかもしれませんが、とりあえず動きます。

読み込むテキストファイル名の指定方法が明記されてなかったので、プログラムの最初に設定してあるフォルダにある*.txtファイルを全て対象として、各ファイルの名前のついてシート名を追加し、テキストファイルの内容をシートに挿入する、という仕様で作ってみました。

Alt+F11でVBEを起動し、ThisWorkBookをダブルクリックして（あるいは標準モジュールでも可）下記のVBAを貼り付けて実行してみてください。（フォルダ名は書き換えてくださいね）
やりたいことが異なる場合は補足してください。

Sub ReadTextFiles()
　　Const DirName = "C:\TEMP"
　　'上記で指定されたフォルダに存在するファイルで、
　　'拡張子がtxtのものをすべて１シートとして読み込む

　　Dim fs, dir, fc, f1, stream As Object
　　Set fs = CreateObject("Scripting.FileSystemObject")
　　Set dir = fs.GetFolder(DirName)
　　Set fc = dir.Files
　　For Each f1 In fc
　　　　If LCase(fs.GetExtensionName(f1.Name)) = "txt" Then
　　　　　　Worksheets.Add after:=Worksheets(Worksheets.Count)
　　　　　　Sheets(Worksheets.Count).Name = f1.Name
　　　　　　Set stream = f1.OpenAsTextStream
　　　　　　Do While stream.AtEndOfStream <> True
　　　　　　　　Cells(stream.Line, 1) = stream.ReadLine
　　　　　　Loop
　　　　　　stream.Close
　　　　End If
　　Next
End Sub

お礼

早速のご対応、ありがとうございます。
マクロは勉強せねばと思いつつ、勉強してこなかったため、このような丁寧な対応をしていただきまして大変助かります。
早速、使わせて頂きたいと思います。
ありがとうございました。

回答No.1

toshi_2000

マクロを作るしかないですね。