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
複数のテキストファイルをひとつのエクセルシートにまとめるには?
Excel(エクセル)
-
9
複数のtxtの特定部分を抽出し、一つのxlsファイルにまとめたいです。
Excel(エクセル)
-
10
フォルダ内全ファイルをシート毎に貼付方法について
Visual Basic(VBA)
-
11
エクセル:マクロ「Application.CutCopyMode = False」って?
Excel(エクセル)
-
12
【VBA】複数のtxtファイルから特定区間の複数行を呼び出し、エクセルにまとめたい。
Visual Basic(VBA)
-
13
VBAでテキストファイルを複数開いて順番に処理する方法がわからないです。
Visual Basic(VBA)
-
14
Excelにて、フォルダ内のTextファイルをマクロで統合すると文字化けしてしまう時の解消コード
Excel(エクセル)
-
15
Excelで空白セル直前のセルデータ値を取得したい
Visual Basic(VBA)
-
16
テキストファイルの一部分を抽出する方法について
Visual Basic(VBA)
-
17
コマンドプロンプトの「%1」と「%~1」の違いがわからない
その他(プログラミング・Web制作)
-
18
[エクセル VBA]テキストファイルから特定の行のみを抜き出したい 下記のようなテキストファイルから
Excel(エクセル)
-
19
【Excel VBA】CSV取込時、数字の先頭の0を消えないようにするには?
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルでの作業計算方法について
-
Microsoft1Officeの互換ソフト...
-
【マクロ】その時、その時で変...
-
はがきについて。
-
【マクロ】読取専用のファイル...
-
エクセル初心者です 関数の入れ...
-
【関数】適切な文字数の数字を...
-
LOOKUP関数を使えばいいのでし...
-
【関数】先頭だけにある、半角...
-
Excel ピボットテーブルで日付...
-
Excelのpivotについて質問です
-
時間によってファイル名が変わ...
-
エクセル 白黒印刷で白線を印刷...
-
Aというブックの1というシート...
-
エクセル関数を教えてください
-
WPS OFFICEでの縦書きについて
-
Excelのチェックボックスの使い...
-
エクセルの条件付き書式につい...
-
エクセルのセルに同じ大きさの...
-
エクセルの関数について教えて...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel 2019 のピボットテーブル...
-
[関数得意な方]教えて下さい・...
-
Excelにてある膨大なデータを管...
-
[関数について]わかる方教えて...
-
Excel初心者です。 詳しい方、...
-
excelの不要な行の削除ができな...
-
エクセル関数に詳しい方教えて...
-
INDIRECTを使わず excelで複数...
-
[オートフィルタ]で抽出された...
-
エクセルの神よ、ご回答を! エ...
-
エクセル関数に詳しい方、教え...
-
各ページの1番上の表示について
-
Excelで写真のような表を作った...
-
エクセルで不等号記号(≠)が上に...
-
数学 Tan(θ)-1/Cos(θ)について...
-
Excel 2019 は、SPILL機能があ...
-
Excelで全角を半角にしたいので...
-
条件付き書式を教えてください
-
Excel フィルターを掛けた状態...
-
[オートフィルタ]の適用範囲の...
おすすめ情報