VBAでテキストファイルを複数開いて順番に処理する方法がわからないです。

以下のところでテキストファイルを複数開いて処理する方法がわかりません。どなたか詳しい方教えていただきたいです。

Sub テキスト読み込み()

'iはファイルの個数を表す
Dim i As Long



'複数のファイルを開くことができるようにする
Dim txtName, txtName1, fName As Variant
fName = Application.GetOpenFilename("テキストファイル,*.txt", MultiSelect:=True)



' ファイルのキャンセル処理
If IsArray(fName) = "False" Then
MsgBox "キャンセルしました。"
Exit Sub '終了
End If




For i = LBound(fName) To UBound(fName)

　　　'ここをどうすればいいかわからない
Set txtName = Workbooks.OpenText(fName(i))


txtName1 = txtName


' #1はテキストファイルのカンマ区切り部分
If txtName <> "False" Then
Open txtName For Input As #1
End If

' #2はテキストファイルのタブ区切り部分
If txtName <> "False" Then
Open txtName1 For Input As #2
End If


色々処理・・・



Next i




End Sub

質問者からの補足コメント

• もともとは以下のマクロでテキストファイル１つの内容をシート1に貼りつけるものでした。この流れで複数のテキストファイルをまとめてシート1に貼りつけようと思ったらどうすればいいでしょうか。
  
  Sub テキスト読み込み()
  
  Dim txtName As String
  txtName = Application.GetOpenFilename("テキストファイル,*.txt")
  
  If txtName = "False" Then
  MsgBox "キャンセルしました。"
  Exit Sub '終了
  End If
  
  txtName1 = txtName
  続く

    補足日時：2021/05/11 14:37

• 続き
  If txtName <> "False" Then
  Open txtName For Input As #1
  End If
  
  If txtName <> "False" Then
  Open txtName1 For Input As #2
  End If
  
  Dim START_GYOU As Integer
  Dim wb As Workbook
  Dim ws, ws_txtData As Worksheet
  Dim IRow, IRow_txtData As Long
  Set wb = ThisWorkbook
  Set ws = wb.Sheets("データ入力")
  Set ws_txtData = wb.Sheets("テキストデータ読み込み")

    補足日時：2021/05/11 14:42

• 続き
  Application.ScreenUpdating = False
  
  
  With ws_txtData
  
  .Cells.ClearContents
  
  START_GYOU = 12 '12行目から書き出す
  
  Do Until EOF(1)
  
  Dim buf As String
  Line Input #1, buf
  
  Dim aryLine As Variant '文字列格納用配列変数
  aryLine = Split(buf, ";") '読み込んだ行を""内の文字区切りで配列変数に格納
  Dim i As Long
  For i = 1 To 19

    補足日時：2021/05/11 14:45

• 'インデックスが0から始まるので列番号に合わせるため+1
  .Cells(START_GYOU, i + 2) = aryLine(i)
  Next
  
  START_GYOU = START_GYOU + 1
  Loop
  
  Close #1
  
  End With
  
  
  'データ入力書式に貼り付け
  With ws
  
  'データ入力シートの最終行を格納する
  IRow = .Cells(Rows.Count, 1).End(xlUp).Row
  
  'テキストデータ読み込みシートの最終行を格納する
  IRow_txtData = .Cells(Rows.Count, 3).End(xlUp).Row
  ' MsgBox IRow_txtData, vbInformation

    補足日時：2021/05/11 14:46

• .Range("A12:T" & IRow).ClearContents
  .Range("A12:T" & IRow_txtData).Value = ws_txtData.Range("A12:T" & IRow_txtData).Value
  
  START_GYOU = 12 '12行目から書き出す
  
  
  Do Until EOF(2)
  Dim buf1 As String
  Line Input #2, buf1
  Dim aryLine1 As Variant
  
  aryLine1 = Split(buf1, "　")
  
  .Cells(START_GYOU, 1) = aryLine1(0)

    補足日時：2021/05/11 14:49

• .Cells(START_GYOU, 2) = aryLine1(2)
  
  START_GYOU = START_GYOU + 1
  
  Loop
  
  Close #2
  
  Application.ScreenUpdating = True
  
  
  End With
  
  
  MsgBox "終了しました。", vbInformation
  
  End Sub

    補足日時：2021/05/11 14:50

• 読み込むテキストデータは以下のようなデータが何百行もあります。
  
  ＜ｄｉｖ　　ｃｌａｓｓ＝”ｔｅｘｔ”　　　　　　　　　　　　　　　　　　　　;1;1;BAT1;BA2032SM;電池ﾎﾙﾀﾞ;;ﾒﾓﾘﾌﾟﾛﾃｸｼｮﾝﾃﾞﾊﾞｲｽ;;;;補助材;;;キャズテック;電池ﾎﾙﾀﾞ;個;;2ZSMKI11BA2032SM 00;49;購入単位：500
  ＜ｄｉｖ　　ｃｌａｓｓ＝”ｔｅｘｔ”　　　　　　　　　　　　　　　　　　　　;2;0;BAT1;BH-32;電池ﾎﾙﾀﾞ;;日本;;;非実装;補助材;;;日本;電池ﾎﾙﾀﾞ;;;3ZSMTO01BH-32 00;;
  ＜ｄｉｖ　　ｃｌａｓｓ＝”ｔｅｘｔ”　　　　　　　　　　　　　　　　　　　　;3;0;※BAT1;CR2032L-B;電池;;日本電池;4;;非実装;;CR2032;;日本電池;電池;;;;;

    補足日時：2021/05/11 14:56

No.8 ベストアンサー 回答者： Qchan1962 回答日時： 2021/05/14 10:18

こんにちは

＞テキストデータ読み込みに出力のほうではB列に連番が表示されておりました。
そうですね。補足のテキストデータを見ると
With ws_txtData　では　；区切りなので
aryLine = Split(buf, ";")のaryLine(1)の1がB列に来ます
aryLine(1)は、aryLine(0)の次なので2番目の値

With ws　では
aryLine1 = Split(buf1, "　")
.Cells(START_GYOU, 1) = aryLine1(0)　’1番目をA列に
.Cells(START_GYOU, 2) = aryLine1(2)　’3番目をB列に
出力されています。
つまり、A列B列の値は上書きされ
A列＜ｄｉｖ　　ｃｌａｓｓ＝”ｔｅｘｔ”半角スペース多数　が
1番目：＜ｄｉｖ　に上書きされ

B列　1（連番？）は　3番目：ｃｌａｓｓ＝”ｔｅｘｔ”　に上書きされます
aryLine1(2)はSplit(buf1, "　")の3番目の値

ちなみに
txtName1 = txtName
　If txtName <> "False" Then
Open txtName For Input As #1
End If
If txtName <> "False" Then
Open txtName1 For Input As #2
End If
同じテキストデータを開いている（何で？と判り難くなっている）
.Range("A12:T" & IRow_txtData).Value = _
ws_txtData.Range("A12:T" & IRow_txtData).Value

この段階で
Sheets("データ入力")のA12以下のデータはSheets("テキストデータ読み込み")と同じなので、
ここに　aryLine1 = Split(buf1, "　")以下を
実行するとA列B列が書き換えられて　連番がB列が消えます。

もし、B列より右を消すことなく
Sheets("テキストデータ読み込み")のA列の値を分けたいにであれば
一列分ずらす必要があります。
方法としては、見出しなどの対応が必要と思いますが、出力位置を変えれば良いだけです。

With ThisWorkbook.Worksheets("データ入力")
.Cells.ClearContents
.Range("B12").Resize(10000, UBound(Ary, 2) + 1) = Ary
.Range("A12").Resize(10000, UBound(Ary1, 2) + 1) = Ary1
End With

この回答へのお礼

早い回答ありがとうございます。すごいです！感動しております。とても助かりました。ありがとうございました。マクロ内容はよくわかっていませんが、これから勉強します！

お礼日時：2021/05/14 10:59

No.7 回答者： Qchan1962 回答日時： 2021/05/13 16:23

補足のテキストデータで検証してみました

基本的な部分が抜けておりましたので修正してください。

出力部分
.Range("A12").Resize(10000, UBound(Ary, 2)) = Ary
正しくは
.Range("A12").Resize(10000, UBound(Ary, 2) + 1) = Ary


＜ｄｉｖ　　ｃｌａｓｓ＝”ｔｅｘｔ”　　　　　　　　　　　　　　　　　　　　;1;1;BAT1;BA2032SM;電池ﾎﾙﾀﾞ;;ﾒﾓﾘﾌﾟﾛﾃｸｼｮﾝﾃﾞﾊﾞｲｽ;;;;補助材;;;キャズテック;電池ﾎﾙﾀﾞ;個;;2ZSMKI11BA2032SM 00;49;購入単位：500

検証したら、U列迄あるような？　21データ

ひょっとして　出力部分は

With ThisWorkbook.Worksheets("テキストデータ読み込み")
.Cells.ClearContents
.Range("A12").Resize(10000, UBound(Ary, 2) + 1) = Ary
End With

With ThisWorkbook.Worksheets("データ入力")
.Cells.ClearContents
.Range("A12").Resize(10000, UBound(Ary, 2) + 1) = Ary
.Range("A12").Resize(10000, UBound(Ary1, 2) + 1) = Ary1
End With

これで良いのかも・・

データ入力シートの結果：添付図

この回答へのお礼

ありがとうございます。エラーは出ず、処理速度がめちゃくちゃ早くてびっくりしました。最後のところで１つ質問なのですが、データ入力シートの結果：添付図でC列に連番が出てこないのはどうしてなのでしょうか。

With ThisWorkbook.Worksheets("データ入力")
.Cells.ClearContents
.Range("A12").Resize(10000, UBound(Ary, 2) + 1) = Ary
.Range("A12").Resize(10000, UBound(Ary1, 2) + 1) = Ary1
End With


テキストデータ読み込みに出力のほうではB列に連番が表示されておりました。

お礼日時：2021/05/14 09:37

No.6 回答者： Qchan1962 回答日時： 2021/05/13 13:56

こんにちは、

どの様なエラーでしょうか、、　＃５の回答に変数宣言書かなかったのですが、宣言されましたか、？、されているとして　見直してみました。

Ary1部分ではないのですが。
＞.Range("A12:T"
すみません。カラム20までなのですね。最後に;あるのかな。。
あとセミコロンでした。

配列のサイズはデータのサイズで宣言したり、データを入れる度にサイズを増やしたりするべきと思いますが、初めにサイズを宣言しています
この部分は直すべきかも知れませんが、とりあえず

ご質問補足コードを見て私が書いた全コードです
コメントになっているコードは、イマイチなさりたい事が分からないので、実行から外しました。

Sub Sample()
　Dim folderPath As String, txtPath As String
　Dim AryFllPath() As String
　Dim n As Long, i As Long, j As Long
　Dim buf As String
　Dim aryLine As Variant, aryLine1 As Variant
　ReDim Ary(9999, 20), Ary1(9999, 1)
　'ダイアログボックスで選択したファイルを配列に入れる
　With Application.FileDialog(msoFileDialogFilePicker)
　 　.AllowMultiSelect = True 'ファイルの複数選択を可能にする
　 　.Filters.Clear
　 　.Filters.Add "テキストファイル", "*.txt"
　 　'初期表示フォルダの設定
　 　.InitialFileName = CreateObject("WScript.Shell").SpecialFolders("desktop")
　 　If .Show = -1 Then 'ファイルダイアログ表示
　 　 　' OKボタンが押された場合
　 　 　For i = 1 To .SelectedItems.Count
　 　 　 　ReDim Preserve AryFllPath(i - 1)
　 　 　 　AryFllPath(i - 1) = .SelectedItems(i)
　 　 　Next i
　 　Else
　 　 　MsgBox "キャンセルしました": Exit Sub
　 　End If
　End With
　'パスの入った配列のデータを元にファイルを開く
　n = 0
　For i = 0 To UBound(AryFllPath)
　 　Open AryFllPath(i) For Input As #1
　 　Do Until EOF(1)
　 　 　Line Input #1, buf
　 　 　aryLine = Split(buf, ";")
　 　 　'カンマ区切りデータを2次元配列に代入
　 　 　For j = 0 To UBound(aryLine)
　 　 　 　Ary(n, j) = aryLine(j)
　 　 　Next j
　 　 　aryLine1 = Split(buf, "　")
　 　 　If UBound(aryLine1) = 0 Then Ary1(n, 0) = aryLine1(0)
　 　 　If UBound(aryLine1) >= 2 Then
　 　 　 　Ary1(n, 0) = aryLine1(0)
　 　 　 　Ary1(n, 1) = aryLine1(2)
　 　 　End If
　 　 　n = n + 1
　 　Loop
　 　Close #1
　Next
　'データすべてを取得したらシートに書き出す
　With ThisWorkbook.Worksheets("テキストデータ読み込み")
　 　.Cells.ClearContents
　 　.Range("A12").Resize(10000, UBound(Ary, 2)) = Ary
　End With
　With ThisWorkbook.Worksheets("データ入力")
　 　.Cells.ClearContents
　 　'データ入力シートの最終行を格納する
　 　' 　 　IRow = .Cells(Rows.Count, 1).End(xlUp).Row
　 　'テキストデータ読み込みシートの最終行を格納する
　 　' 　 　IRow_txtData = .Cells(Rows.Count, 3).End(xlUp).Row
　 　' MsgBox IRow_txtData, vbInformation
　 　' 　 　.Range("A12:T" & IRow).ClearContents
　 　' 　 　.Range("A12:T" & IRow_txtData).Value = ws_txtData.Range("A12:T" & IRow_txtData).Value
　 　.Range("A12").Resize(10000, 2) = Ary1
　End With
End Sub

No.5 回答者： Qchan1962 回答日時： 2021/05/12 18:18

＃４です

＞手動で複数個選択したい場合どうすればいいのでしょうか。
この場合は、＃４のコードの下記部分を変更してください。

元コード
'フォルダ内のテキストファイルすべてを配列に入れる
　With Application.FileDialog(msoFileDialogFolderPicker)
　 　.InitialFileName = CreateObject("WScript.Shell").SpecialFolders("desktop")
　 　If .Show = True Then
　 　 　folderPath = .SelectedItems(1)
　 　End If
　End With
　If folderPath = "" Then Exit Sub
　
　'フォルダ内すべてのテキストファイルパスをDirで配列に取得
　txtPath = Dir(folderPath & "\" & "*.txt")
　Do Until txtPath = ""
　 　ReDim Preserve AryFllPath(n)
　 　AryFllPath(n) = folderPath & "\" & txtPath
　 　n = n + 1
　 　txtPath = Dir
　Loop

書き換えコード
'ダイアログボックスで選択したファイルを配列に入れる
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True 'ファイルの複数選択を可能にする
.Filters.Clear
.Filters.Add "テキストファイル", "*.txt"
'初期表示フォルダの設定
.InitialFileName = CreateObject("WScript.Shell").SpecialFolders("desktop")

If .Show = -1 Then 'ファイルダイアログ表示
' OKボタンが押された場合
For i = 1 To .SelectedItems.Count
ReDim Preserve AryFllPath(i - 1)
AryFllPath(i - 1) = .SelectedItems(i)
Next i
Else
MsgBox "キャンセルしました": Exit Sub
End If
End With

書き換え先に準じ　With　で書いています。


あと、解釈が違っていたら仕方ないいのですが、
Sheets("データ入力")の方を加えてみました。
サンプルデータを作れないので検証していません。。。
（なので不明な点はコメントにしています）

ファイルpathの配列で順次テキストを開いて配列に入れ
纏めて書き出しています。

'パスの入った配列のデータを元にファイルを開く
n = 0
For i = 0 To UBound(AryFllPath)
Open AryFllPath(i) For Input As #1
Do Until EOF(1)
Line Input #1, buf
aryLine = Split(buf, ",")
'カンマ区切りデータを2次元配列に代入
For j = 0 To UBound(aryLine)
Ary(n, j) = aryLine(j)
Next j
aryLine1 = Split(buf, "　")
If UBound(aryLine1) = 0 Then Ary1(n, 0) = aryLine1(0)
If UBound(aryLine1) >= 2 Then Ary1(n, 1) = aryLine1(2)
n = n + 1
Loop
Close #1
Next

'データすべてを取得したらシートに書き出す
With ThisWorkbook.Worksheets("テキストデータ読み込み")
.Cells.ClearContents
.Range("A12").Resize(10000, UBound(Ary, 2)) = Ary
End With

With ThisWorkbook.Worksheets("データ入力")
.Cells.ClearContents
'データ入力シートの最終行を格納する
' IRow = .Cells(Rows.Count, 1).End(xlUp).Row
'テキストデータ読み込みシートの最終行を格納する
' IRow_txtData = .Cells(Rows.Count, 3).End(xlUp).Row
' MsgBox IRow_txtData, vbInformation
' .Range("A12:T" & IRow).ClearContents
.Range("A12:T" & IRow_txtData).Value = ws_txtData.Range("A12:T" & IRow_txtData).Value

.Range("A12").Resize(10000, 2) = Ary1
End With

End Sub

この回答へのお礼

再度回答ありがとうございます。以下←のところAry1(n, 0)でエラーがでるのですが、どこかでFunctionを定義するのでしょうか。配列に詳しくないのでまた教えていただけますか。

'フォルダ内すべてのテキストファイルパスをDirで配列に取得
txtPath = Dir(folderPath & "\" & "*.txt")

Do Until txtPath = ""
ReDim Preserve AryFllPath(n)
AryFllPath(n) = folderPath & "\" & txtPath
n = n + 1
txtPath = Dir
Loop


'パスの入った配列のデータを元にファイルを開く
n = 0

For i = 0 To UBound(AryFllPath)
Open AryFllPath(i) For Input As #1
Do Until EOF(1)
Line Input #1, buf
aryLine = Split(buf, ",")
'カンマ区切りデータを2次元配列に代入
For j = 0 To UBound(aryLine)
ary(n, j) = aryLine(j)
Next j

aryLine1 = Split(buf, "　")
If UBound(aryLine1) = 0 Then Ary1(n, 0) = aryLine1(0)　←
If UBound(aryLine1) >= 2 Then Ary1(n, 1) = aryLine1(2)
n = n + 1
Loop
Close #1
Next

お礼日時：2021/05/13 10:14

No.4 回答者： Qchan1962 回答日時： 2021/05/11 19:36

こんばんは

示されているコードで問題なく1ファイルが取得できるとして
表題の方法として、複数テキストファイルを開くのではなく、
順次開いて書き込む　ような感じになると思います。
With ws　部分は、すこし違和感を感じます。
txtName1 = txtName　と書かれているので同じテキストデータを加工して
Sheets("データ入力")に出力したいのだと思いますが、
同じファイルでのカンマ区切り、タブ区切り？のデータの違いなど
よく分からないので　Sheets("テキストデータ読み込み")に対してのみの
処理を書いてみました。

正解が分からないので何とも言えませんが、
もし問題がないようでしたら、データ作成処理部分でタブ区切りように
出力配列変数を増やして実行する事も可能と思います。
Sampleコードに下記を追加するとか
aryLine1 = Split(buf, "　")
For jj = 0 To UBound(aryLine1)
Ary1(n, jj) = aryLine(jj)
Next jj
-----
With ThisWorkbook.Worksheets("データ入力")
.Cells.ClearContents
.Range("A12").Resize(10000, UBound(Ary1, 2)) = Ary1
End With


Sheets("データ入力")のみ対応サンプルです

Sub Sample()
　Dim folderPath As String, txtPath As String
　Dim AryFllPath() As String
　Dim n As Long, i As Long, j As Long
　Dim buf As String, aryLine As Variant
　ReDim Ary(9999, 19)

　'テキストファイルのあるフォルダをダイアログで選択
　With Application.FileDialog(msoFileDialogFolderPicker)
　 　.InitialFileName = CreateObject("WScript.Shell").SpecialFolders("desktop")
　 　If .Show = True Then
　 　 　folderPath = .SelectedItems(1)
　 　End If
　End With
　If folderPath = "" Then Exit Sub
　
　'フォルダ内すべてのテキストファイルパスをDirで配列に取得
　txtPath = Dir(folderPath & "\" & "*.txt")
　Do Until txtPath = ""
　 　ReDim Preserve AryFllPath(n)
　 　AryFllPath(n) = folderPath & "\" & txtPath
　 　n = n + 1
　 　txtPath = Dir
　Loop
　
　'パスの入った配列のデータを元にファイルを開く
　n = 0
　For i = 0 To UBound(AryFllPath)
　 　Open AryFllPath(i) For Input As #1
　 　Do Until EOF(1)
　 　 　Line Input #1, buf
　 　 　aryLine = Split(buf, ",")
　 　 　'カンマ区切りデータを2次元配列に代入
　 　 　For j = 0 To UBound(aryLine)
　 　 　 　Ary(n, j) = aryLine(j)
　 　 　Next j
　 　 　n = n + 1
　 　Loop
　 　Close #1
　Next
　
　'データすべてを取得したらシートに書き出す
　With ThisWorkbook.Worksheets("テキストデータ読み込み")
　 　.Cells.ClearContents
　 　.Range("A12").Resize(10000, UBound(Ary, 2)) = Ary
　End With
End Sub

.Cells.ClearContentsなので、
配列サイズ適当にしましたが取敢えずですみません。

この回答へのお礼

回答ありがとうございます。質問したいのですが以下の部分でフォルダのテキストファイルを手動で複数個選択したい場合どうすればいいのでしょうか。

'テキストファイルのあるフォルダをダイアログで選択
With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = CreateObject("WScript.Shell").CurrentDirectory

If .Show = True Then
folderPath = .SelectedItems(1)
End If

End With

お礼日時：2021/05/12 08:54

No.3 回答者： ぽち101 回答日時： 2021/05/11 13:56

これで動きませんか？

変更前：Set txtName = Workbooks.OpenText(fName(i))
変更後：txtName = fName(i)

あと、「色々処理・・・」のところに
「Close #1」と「Close #2」はありますよね？

目的を教えていただくことが可能であれば、その方がいいかもしれないですね。
例えば、カンマ区切りとタブ区切り（中身がcsvやtsv）の*.txtファイルを
○○処理したいみたいな感じで。

No.2 回答者： fujillin 回答日時： 2021/05/11 13:22

こんにちは

＞Set txtName = Workbooks.OpenText(fName(i))
ここで何をしたいのかわかりませんが・・・

OpenTextメソッドには戻り値がないようなので、単独で、
　Workbooks.OpenText Filename:=fName(i)
とすれば、テキストファイルをシートに読み込むことができます。
（判断はエクセル任せですが…）
https://docs.microsoft.com/ja-jp/office/vba/api/ …
データを操作したい場合は、直後にActiveSheetを取得しておくことになります。

とは言え、その後で
＞' #1はテキストファイルのカンマ区切り部分
＞Open txtName For Input As #1
などとあるので、上記ではファイルを開きたいわけではないのかとも思いますが、何を意図しているのかがわかりません。

また、
＞If txtName <> "False" Then
って、条件判定が#1、#2の両方とも同じなので、ますます何をどうしたいのか不明です。

更に、
＞Set txtName = Workbooks.OpenText(fName(i))
＞txtName1 = txtName
txtNameに何を取得することを期待しているのか不明ですけれど（型宣言もないので）、Set で取得しようとしているので、オブジェクト等のはずなのですが、それにしては
＞txtName1 = txtName
は、ますます意味不明です。

・・・ってことで、さっぱりわかりませんけれど
＞Open txtName For Input As #1、
txtNameがファイルパスの文字列なら、fName(i)等のはずですし・・・？
もしも、シートを介さずに通常のテキストファイル読み込みで処理を行うつもりであるのなら、最初の
＞Workbooks.OpenText(fName(i))
で、ファイルを開く必要もないのでは？

No.1 回答者： ShowMeHow 回答日時： 2021/05/11 12:30

ファイルをダイアログから指定して開きたいのですか？

それとも、フォルダ内のtxtファイル全部を一括処理したいのですか？