VBA初心者です。宜しくお願いします。
複数のテキストファイルを一括でエクセルの同一Bookにシート毎に取り込みたいと考えております。ネットを色々調べてみて取り込みまでは出来たのですが、テキスト内容は空白によって区切られているので、セルごとに区切られません。エクセルにて1ファイルごとは取り込めるのですが、一括の場合は一つのセルにテキストがまとまってしまします。行は分かれてますが列が分かれません。色々と試しましたが、知識が無いためにこれ以上進みません。どうかお力を貸して下さい。win Excel2016です。
下記のソース?で取り込む事が出来ました。
Sub ReadTextFiles()
Const DirName = "C:\Users\"
'上記で指定されたフォルダに存在するファイルで、
'拡張子がtxtのものをすべて1シートとして読み込む
Dim fs As Object
Dim dir 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
また下記がエクセルマクロにて保存した内容です。
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\.txt", Destination:=Range( _
"$A$1"))
.CommandType = 0
.Name = "1001"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
No.2
- 回答日時:
いかのようにしてください。
-------------------------------------
Sub ReadTextFiles()
Const DirName = "C:\Users\"
'上記で指定されたフォルダに存在するファイルで、
'拡張子がtxtのものをすべて1シートとして読み込む
Dim fs As Object
Dim dir As Object
Dim RE As Object
Dim fc As Object
Dim f1 As Object
Dim stream As Object
Dim line As String
Dim items As Variant
Dim i As Long
Dim row As Long
Set RE = CreateObject("VBScript.RegExp")
RE.Pattern = "[ ]+"
RE.Global = True
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
row = stream.line
'連続する空白を1つにまとめる
line = stream.ReadLine
line = RE.Replace(line, " ")
items = Split(line, " ")
For i = 0 To UBound(items)
Cells(row, 1 + i).Value = items(i)
Next
Loop
stream.Close
End If
Next
End Sub
---------------------------
No.1
- 回答日時:
これでどうかな
Sub ReadTextFiles()
Const DirName = "C:\Users\"
'上記で指定されたフォルダに存在するファイルで、
'拡張子がtxtのものをすべて1シートとして読み込む
Dim fs As Object
Dim dir As Object
Dim fc, f1, stream, myArray
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
myArray = Split(stream.ReadLine, Space(1))
If UBound(myArray) >= 0 Then
Cells(stream.Line, 1).Resize(1, UBound(myArray) + 1).Value = myArray
End If
Loop
stream.Close
End If
Next
End Sub
ki-aaaさん有難う御座います。私の説明がいけないんだと思いますが、取り込みはしましたけど私が記述した結果と同じでした。たぶんテキストデータの説明が悪いんだと思います。
動作結果このような形です。
文字列が分割されず、一つ目のセルに記述された状態です。
1111111あいうえお22222かきくけこ333333さしすせそ
2222222たちつてと55555さしすせそ7777779999999999
Cells(stream.Line, 1).Resize(1, UBound(myArray) + 6).Value = myArray とした場合に、
一つのセル毎に分割されない文字列がインポートされました。
参考になるか解りませんが、メモ帳に記述されているテキスト例はこのような感じです。
1111111 あいうえお 22222 かきくけこ 333333 さしすせそ
2222222 たちつてと 55555 さしすせそ 777777 9999999999
1ファイルをエクセルにてインポートする場合は、区切り文字で区切られています。
データプレビューにてみると、一つ目のセルと二つ目のセルの区切りを2列目の文字頭で
区切りがあり、以降の列も文字頭で区切られております。
1111111 |あいうえお |22222 |かきくけこ |333333 |さしすせそ
2222222 |たちつてと |55555 |さしすせそ |777777 |9999999999
上手く伝えられなくて申し訳ありません。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 複数のcsvファイルをExcelに一括変換したい 2 2023/03/03 12:44
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Visual Basic(VBA) EXCEL VBAにて動的にCheckBOXを複数作成し、同BOXにイベントを追加したい 1 2023/03/16 07:05
- Visual Basic(VBA) 貼り付けた値が消えていく 以下はソースファイルの2番目のシートのB6から最終行を取得 ターゲットファ 2 2023/07/27 12:23
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
このQ&Aを見た人はこんなQ&Aも見ています
-
性格の違いは生まれた順番で決まる?長男長女・中間子・末っ子・一人っ子の性格の傾向
同じ環境で生まれ育っても、生まれ順で性格は違うものなのだろうか。家庭教育研究家の田宮由美さんに教えてもらった。
-
複数のテキストファイルをエクセルに一括で取り込みたい
Excel(エクセル)
-
複数のテキストファイルをexcelでそれぞれ別シートに書き出したい
Excel(エクセル)
-
同一フォルダにある複数のテキストファイル(メモ帳)を一括でエクセルに取り込みたいです。
Visual Basic(VBA)
-
-
4
マクロを使ってフォルダー内にあるtxtデータをエクセルにデータに変換する方法をご教授願います
Excel(エクセル)
-
5
特定フォルダ内のテキストファイルの内容を全てエクセルに書き出す方法
Visual Basic(VBA)
-
6
複数のテキストファイルをエクセルの1シートに連続取り込み
Excel(エクセル)
-
7
複数あるメモ帳を一括でエクセルに貼り付ける方法を教えてください!!
Excel(エクセル)
-
8
VBAでテキストファイルを複数開いて順番に処理する方法がわからないです。
Visual Basic(VBA)
-
9
複数のtxtの特定部分を抽出し、一つのxlsファイルにまとめたいです。
Excel(エクセル)
-
10
【VBA】複数のtxtファイルから特定区間の複数行を呼び出し、エクセルにまとめたい。
Visual Basic(VBA)
-
11
Excelにて、フォルダ内のTextファイルをマクロで統合すると文字化けしてしまう時の解消コード
Excel(エクセル)
-
12
複数のテキストファイルをひとつのエクセルシートにまとめるには?
Excel(エクセル)
-
13
フォルダ内全ファイルをシート毎に貼付方法について
Visual Basic(VBA)
-
14
【VBA】テキストファイルを指定行数からの読み込み
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで 自動的に◯や数字を...
-
エクセルでファイルの最終更新...
-
シフト表をエクセルで作るとき...
-
Excel 2019 [オプション]の[リボンのユ...
-
Excelに詳しい方! B列が「日...
-
Excelファイルが開けません
-
excel2013 MonthDays 関数が使...
-
スプレッドシートの関数につい...
-
【マクロ】2回実行したら、エ...
-
特定の文字列を含む、住所を抽...
-
EXCELの散布図で日付が1900年に...
-
エクセルのツールバーから数値...
-
Excelで表を作ったところに文字...
-
祝日と土曜、日曜の合計をカウ...
-
Excelについて
-
【マクロ】名前を保存する際に...
-
Excel分数の表示について
-
エクセルでCtrl+Tでテーブルの...
-
マイクロソフトのPADを使ってい...
-
【EXCEL】画像の黄色部分の抽出...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
半角カタカナをヘボン式ローマ...
-
(マクロ)vlookupの元データを同...
-
エクセルで上位バイトのセルと...
-
exselの質問です
-
Excel 大小比較演算子による「...
-
Excel VBについての質問です。
-
エクセルの問題です。絶対値の...
-
非表示列の再表示に失敗
-
職場の人から聞かれており、こ...
-
Excel関数-文字列で自動作成さ...
-
Excelデータをコピペして、ペー...
-
ユーザー定義関数をアドイン登...
-
【マクロ】for next構文について
-
エクセルの日付を編集する
-
【マクロ】VLOOKUPにて参照元に...
-
exselで最小数で並び替える関数
-
libre 表計算ソフトの計算がう...
-
エクセルで表
-
エクセルの表で1年間の曜日を...
-
西暦和暦
おすすめ情報