【iOS版アプリ】不具合のお知らせ

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

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に貼りつけるものでした。この流れで複数のテキストファイルをまとめてシート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
  • 読み込むテキストデータは以下のようなデータが何百行もあります。

    <div  class=”text”                    ;1;1;BAT1;BA2032SM;電池ホルダ;;メモリプロテクションデバイス;;;;補助材;;;キャズテック;電池ホルダ;個;;2ZSMKI11BA2032SM 00;49;購入単位:500
    <div  class=”text”                    ;2;0;BAT1;BH-32;電池ホルダ;;日本;;;非実装;補助材;;;日本;電池ホルダ;;;3ZSMTO01BH-32 00;;
    <div  class=”text”                    ;3;0;※BAT1;CR2032L-B;電池;;日本電池;4;;非実装;;CR2032;;日本電池;電池;;;;;

      補足日時:2021/05/11 14:56
gooドクター

A 回答 (8件)

こんにちは


>テキストデータ読み込みに出力のほうでは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列<div  class=”text”半角スペース多数 が
1番目:<div に上書きされ

B列 1(連番?)は 3番目:class=”text” に上書きされます
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
    • good
    • 0
この回答へのお礼

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

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

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


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

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


<div  class=”text”                    ;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

これで良いのかも・・

データ入力シートの結果:添付図
「VBAでテキストファイルを複数開いて順番」の回答画像7
    • good
    • 0
この回答へのお礼

ありがとうございます。エラーは出ず、処理速度がめちゃくちゃ早くてびっくりしました。最後のところで1つ質問なのですが、データ入力シートの結果:添付図で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

こんにちは、


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

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
    • good
    • 0

#4です


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

元コード
'フォルダ内のテキストファイルすべてを配列に入れる
 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
    • good
    • 1
この回答へのお礼

再度回答ありがとうございます。以下←のところ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

こんばんは


示されているコードで問題なく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なので、
配列サイズ適当にしましたが取敢えずですみません。
    • good
    • 0
この回答へのお礼

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

'テキストファイルのあるフォルダをダイアログで選択
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

これで動きませんか?


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

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

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

こんにちは



>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))
で、ファイルを開く必要もないのでは?
    • good
    • 0

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


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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング