同一フォルダにある複数のテキストファイル(メモ帳)を一括でエクセルに取り込みたいです。

Excel | Visual Basic33閲覧xmlns="http://www.w3.org/2000/svg">100

ベストアンサー

0

ThanksImg質問者からのお礼コメント

無事解決できました。 ありがとうございました。 他の方もマクロを書いていただいてありがとうございました。

お礼日時:2020/11/29 15:31

その他の回答(2件)

0

>A列に1行2行3行と並んでいくようにまとめたい テキストファイルの文字数は、セル内の許容文字数(32,767 文字)を超えないということですよね? C:\HogeHoge\Hoge\に対象ファイルがある場合の例です。 Sub sample() Const cFld As String = "C:\HogeHoge\Hoge\" Dim rng As Range, xFile As String, i As Long Application.ScreenUpdating = False Set rng = Worksheets.Add.Range("A1") xFile = Dir(cFld & "*.txt") Do While xFile <> "" With Workbooks.Open(cFld & xFile) .Worksheets(1).Range("A1").Copy rng.Offset(i) i = i + 1 .Close False End With xFile = Dir() Loop rng.EntireColumn.AutoFit Application.ScreenUpdating = True End Sub

0

フォルダ指定して処理する方法です。100ファイルだと処理時間がかかると思います。この方法は一括読み込み方式です。ので、読み込み時の行数指定はできません。また、転記先のファイル毎の区切りはありません。 Sub test() Dim fs As New FileSystemObject Dim ReadStr() As String Dim TargetFolder As String: TargetFolder = "C:\Users\○○\Desktop\△△\" 'フォルダ指定 Dim TargetSheet As Worksheet: Set TargetSheet = Worksheets(1) Dim NowRow As Integer: NowRow = 1 TargetSheet.Cells.Clear '全セルクリア For Each f In fs.GetFolder(TargetFolder).Files ReadStr = Read_Data(f.path) '読み込んだ内容をシートへ出力 For Each D In ReadStr If Len(D) > 0 Then TargetSheet.Cells(NowRow, 1) = D NowRow = NowRow + 1 End If Next D Next f MsgBox ("作業完了") End Sub 'テキストデータ一括読み込み Function Read_Data(ReadPath As String) As String() Dim tmp As String Dim fs As New FileSystemObject Dim ts As TextStream Set ts = fs.OpenTextFile(ReadPath, ForReading) If Not ts Is Nothing Then tmp = ts.ReadAll '一括読込 End If ts.Close Set ts = Nothing Set fs = Nothing Read_Data = Split(tmp, vbCrLf) End Function