![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?a65a0e2)
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
![](http://oshiete.xgoo.jp/images/v2/common/profile/M/noimageicon_setting_14.png?a65a0e2)
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
複数のテキストファイルをひとつのエクセルシートにまとめるには?
Excel(エクセル)
-
5
マクロを使ってフォルダー内にあるtxtデータをエクセルにデータに変換する方法をご教授願います
Excel(エクセル)
-
6
特定フォルダ内のテキストファイルの内容を全てエクセルに書き出す方法
Visual Basic(VBA)
-
7
複数のテキストファイルをエクセルの1シートに連続取り込み
Excel(エクセル)
-
8
【VBA】複数のtxtファイルから特定区間の複数行を呼び出し、エクセルにまとめたい。
Visual Basic(VBA)
-
9
【Excel VBA】取り込んだファイルのファイル名を取得するには?
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel 偶数月の15日(土日祝...
-
Excelの数式について教えてくだ...
-
Excelのメニューについて
-
VLOOKUP FALSEのこと
-
エクセル内に読み込んが画像の...
-
【マクロ】1回目の実行後、2...
-
勤務外時間を出す表が作りたい
-
Excelで作成した出欠表から日付...
-
エクセルの数式について教えて...
-
【マクロ】参照渡しとモジュー...
-
Excelの条件付書式について教え...
-
【マクロ】シート追加時に同じ...
-
マクロを実行すると、セル範囲...
-
【マクロ】参照渡しについて。...
-
Excel 日付の表示が直せません...
-
エクセルで、数字の下4桁の0を...
-
【マクロ】Call関数で呼び出し...
-
別のシートの指定列の最終行を...
-
Excelのデーターバーについて
-
Excelでの文字入力について
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【マクロ】重複する同じ行を、...
-
Excelの条件付き書式のコピーと...
-
vba 印刷設定でのカラー印刷と...
-
VBA の単語の意味を教えて下さい。
-
Excel 日付の表示が直せません...
-
エクセル 同じ行の隣り合う数字...
-
エクセル条件付き書式について。
-
エクセルの数式につきまして
-
ファイル名の変更
-
エクセル 数字のみ抽出につて
-
Excelの開始ブックを固定したい...
-
エクセルの数式について教えて...
-
エクセルのセルをクリックする...
-
=INDIRECT(RIGHT(CELL("filenam...
-
エクスプローラーで見ることは...
-
Excelの関数で質問です
-
至急お願いいたします 屋上の備...
-
エクセルでセルに入力する前は...
-
関数を教えて下さい
-
Excel 関数での質問です
おすすめ情報