EXCEL VBA 連番のテキストファイルを合計ファイルに纏める・集計処理・１つのテキストファイルにまとめる（テクニック）

2020年5月31日

EXCEL VBA 連番のテキストファイルを合計ファイルに纏める・集計処理・１つのテキストファイルにまとめる（テクニック）

●はじめに

社内の事務処理で、複数のデータ（ファイル）などを集計する事があると思いますが、今回は、連番で作成されたテキストファイルのデータを集計（読み込み）し、集計した結果を合計ファイルとして出力するサンプルプログラムです。大量のデータを集計するには、便利だと思います。それでは、順番にプログラムの説明をいたします。

●プログラム説明　（サンプル①）

下記のサンプルプログラムは、連番（複数）のテキストファイルを合計ファイルに纏めるサンプルプログラムです。

【プログラム説明①】

【プログラム説明②】

【プログラム実行条件】
・テキストファイルの名前は、「sample01.txt」～の「sample99.txt」までの範囲
・テキストファイルの内容は、下図の通りに、１行目に、右側（全角二文字：名前）・左側（半角数字１文字＋”点）にする。

・読み込むテキストのファイル形式（文字コード）は、「ＡＮＳＩ」のみに対応しています。
※「ＵＴＦ－８」には対応していません。
・テキストファイルの保存先は、「C:\TEST\」
※下記のプログラムを実行する際は、【プログラム実行条件】が必須となります。

'
'******** AKIRA55.COM ******* https://akira55.com/textfiles/
'
Sub TextFiles01()   '連番（複数）のテキストファイルを合計ファイルに纏める

    Dim FilePath, SetFilePath, FileNo, txtLine As String
    Dim I, L, M, lRow As Long
    
    FilePath = "C:\TEST\sample"  'ファイルパスとファイル名を指定します。
    
    Cells.ClearContents  'テキストファイルを取り込むシートをクリアー
    
    For L = 1 To 99  'テキストファイルを取り込む最大値を指定（ファイル名の連番１～９９まで）
   
    
    FileNo = Format(Str(L), "00")  'ファイル名に連番を付け足します。
     
    SetFilePath = FilePath & FileNo & ".txt"  'テキストファイルを取り込むフルパスを指定します。①
    
    
        If Dir(SetFilePath) = "" Then    '読み込むテキストファイルを取り込むがなくなるまで繰り返します。
            GoTo DSave  '読み込むファイルがなくなれば、Dsave　（テキストデータの保存へ）
        End If
        
        Open SetFilePath For Input As #1  '①のテキストファイルを指定したフルパスからファイルを開きます
        
        
        Line Input #1, txtLine  'データをTxtLineへ代入します。
        

            lRow = Cells(Rows.Count, "A").End(xlUp).Row + 1  'A列の最終行＋１をｌRowに代入
            
            For M = 1 To lRow  'A列の最終行まで繰り返す。
            
         
                If Cells(M, "A") = "" Then  '初めての名前が発生した場合
                                Cells(M, "A") = Left(txtLine, 2)    '読み込んだデータを名前と点数に分割します。（名前をA列）
                                Cells(M, "B") = Val(Right(txtLine, 2))   '読み込んだデータを名前と点数に分割します。（点数をB列）'
                                Exit For
                End If
                    
                If Cells(M, "A") = Left(txtLine, 2) Then  '既存の名前がある場合
                            Cells(M, "B") = Cells(M, "B") + Val(Right(txtLine, 2)) 'B列の点数を加算します。
                            Exit For
                End If


            Next M
                
        Close #1  '読み込んだテキストファイルを閉じます。

    Next L
    
    
DSave: '合計ファイルをテキストファイルに書き出します。
    
     
    Open FilePath & "合計.txt" For Output As #1  '合計ファイルを出力設定します。（フルパス指定）
     
    I = 1  'データの一件目から出力
    
    Do While Cells(I, "A") <> ""  '出力するデータがなくなるまで１行単位で繰り返します。
            Cells(I, "B") = Cells(I, "B") & "点"  'B列の加算して合計値に”点”文字列を結合します。
            Print #1, Cells(I, "A") & " " & Cells(I, "B")  'テキストデータとして、A列とB列を結合して出力します。
            I = I + 1  '行を加算します。
    Loop
     
    Close #1  '合計ファイルを閉じて保存します。
    
End Sub
'

'******** AKIRA55.COM ******* https://akira55.com/textfiles/

Sub TextFiles01() '連番（複数）のテキストファイルを合計ファイルに纏める

Dim FilePath, SetFilePath, FileNo, txtLine As String

Dim I, L, M, lRow As Long

FilePath = "C:\TEST\sample" 'ファイルパスとファイル名を指定します。

Cells.ClearContents 'テキストファイルを取り込むシートをクリアー

For L = 1 To 99 'テキストファイルを取り込む最大値を指定（ファイル名の連番１～９９まで）

FileNo = Format(Str(L), "00") 'ファイル名に連番を付け足します。

SetFilePath = FilePath & FileNo & ".txt" 'テキストファイルを取り込むフルパスを指定します。①

If Dir(SetFilePath) = "" Then '読み込むテキストファイルを取り込むがなくなるまで繰り返します。

GoTo DSave '読み込むファイルがなくなれば、Dsave　（テキストデータの保存へ）

End If

Open SetFilePath For Input As #1 '①のテキストファイルを指定したフルパスからファイルを開きます

Line Input #1, txtLine 'データをTxtLineへ代入します。

lRow = Cells(Rows.Count, "A").End(xlUp).Row + 1 'A列の最終行＋１をｌRowに代入

For M = 1 To lRow 'A列の最終行まで繰り返す。

If Cells(M, "A") = "" Then '初めての名前が発生した場合

Cells(M, "A") = Left(txtLine, 2) '読み込んだデータを名前と点数に分割します。（名前をA列）

Cells(M, "B") = Val(Right(txtLine, 2)) '読み込んだデータを名前と点数に分割します。（点数をB列）'

Exit For

End If

If Cells(M, "A") = Left(txtLine, 2) Then '既存の名前がある場合

Cells(M, "B") = Cells(M, "B") + Val(Right(txtLine, 2)) 'B列の点数を加算します。

Exit For

End If

Next M

Close #1 '読み込んだテキストファイルを閉じます。

Next L

DSave: '合計ファイルをテキストファイルに書き出します。

Open FilePath & "合計.txt" For Output As #1 '合計ファイルを出力設定します。（フルパス指定）

I = 1 'データの一件目から出力

Do While Cells(I, "A") <> "" '出力するデータがなくなるまで１行単位で繰り返します。

Cells(I, "B") = Cells(I, "B") & "点" 'B列の加算して合計値に”点”文字列を結合します。

Print #1, Cells(I, "A") & " " & Cells(I, "B") 'テキストデータとして、A列とB列を結合して出力します。

I = I + 1 '行を加算します。

Loop

Close #1 '合計ファイルを閉じて保存します。

End Sub

●実行前~実行後　　※プログラム実行後、「C:\TEST\」からテキストファイル（sample01～０６）を読み込みテキストファイル内のデータを集計して、集計結果を「sample合計」に記載されてテキストファイルが出力されました。

EXCEL VBA ダイアログボックスを表示して複数選択したテキストファイルを合計ファイルに纏める・集計処理・１つのテキストファイルにまとめる（テクニック）

●プログラム説明　（サンプル②）

下記のサンプルプログラムは、上記サンプル①の応用になります。処理の内容としては、テキストファイル読み込んで合計ファイルに纏めるサンプルプログラムですが、今回は、ダイアログボックスを表示して該当するテキストファイルを選択して、選択ファイルのみ集計して合計ファイルに纏めます。

【プログラム説明①】

【プログラム説明②】

【プログラム実行条件】
・テキストファイルの名前の指定は無し：「テキストファイルのみ選択可能」
・テキストファイルの内容は、下図の通りに、１行目に、右側（全角二文字：名前）・左側（半角数字１文字＋”点）にする。

・読み込むテキストのファイル形式（文字コード）は、「ＡＮＳＩ」のみに対応しています。
※「ＵＴＦ－８」には対応していません。
・テキストファイルの保存先の指定は、ありません。　合計ファイルは、テキストファイル読込先（保存先）に作成されます。
※下記のプログラムを実行する際は、【プログラム実行条件】が必須となります。

'
'******** AKIRA55.COM ******* https://akira55.com/textfiles/
'
Sub TextFiles02()   'ダイアログボックスで複数選択したテキストファイルを合計ファイルに纏める

    
    Dim FileList As Variant
    Dim FilePath, SetFilePath, FileNo, txtLine As String
    Dim I, L, M, lRow As Long

   
    Cells.ClearContents  'テキストファイルを取り込むシートをクリアー
     
    FileList = Application.GetOpenFilename(FileFilter:="テキストファイル(*.txt),*.txt", MultiSelect:=True)
     
    If VarType(FileList) = vbBoolean Then　 'テキストファイルを選択していなければ、プログラム終了
        Exit Sub
    End If
    
    For I = 1 To UBound(FileList) '選択したテキストファイルの全ファイル繰り返します。

        SetFilePath = FileList(I) 'テキストファイルを取り込むフルパスを指定します。

    
        Open SetFilePath For Input As #1  '①のテキストファイルを指定したフルパスからファイルを開きます
        
        
        Line Input #1, txtLine  'データをTxtLineへ代入します。
        

            lRow = Cells(Rows.Count, "A").End(xlUp).Row + 1  'A列の最終行＋１をｌRowに代入
            
            For M = 1 To lRow  'A列の最終行まで繰り返す。
            
         
                If Cells(M, "A") = "" Then  '初めての名前が発生した場合
                                Cells(M, "A") = Left(txtLine, 2)    '読み込んだデータを名前と点数に分割します。（名前をA列）
                                Cells(M, "B") = Val(Right(txtLine, 2))   '読み込んだデータを名前と点数に分割します。（点数をB列）'
                                Exit For
                End If
                    
                If Cells(M, "A") = Left(txtLine, 2) Then  '既存の名前がある場合
                            Cells(M, "B") = Cells(M, "B") + Val(Right(txtLine, 2)) 'B列の点数を加算します。
                            Exit For
                End If


            Next M
                
        Close #1  '読み込んだテキストファイルを閉じます。

    Next I
    
    
DSave: '合計ファイルをテキストファイルに書き出します。
    
     
    Open FilePath & "合計.txt" For Output As #1  '合計ファイルを出力設定します。（フルパス指定）
     
    I = 1  'データの一件目から出力
    
    Do While Cells(I, "A") <> ""  '出力するデータがなくなるまで１行単位で繰り返します。
            Cells(I, "B") = Cells(I, "B") & "点"  'B列の加算して合計値に”点”文字列を結合します。
            Print #1, Cells(I, "A") & " " & Cells(I, "B")  'テキストデータとして、A列とB列を結合して出力します。
            I = I + 1  '行を加算します。
    Loop
     
    Close #1  '合計ファイルを閉じて保存します。
    

End Sub
’