複数のCSVを１つのcsvファイルに結合するVBA

2025年6月9日 08:22

はじめに

VBAなどでデータを取り込む際に、CSVファイルを扱う機会があると思います。
その際に、csvファイルが複数あるため何度もファイルを開く動作が煩わしくありませんか？

私の場合、社内システムでデータを抽出するときに
複数の条件ごとでデータを抽出、エクセルに取り込んで管理、分析するのですが
CSVファイルが10個以上になるので
取り込む際にCSVファイルを１つのファイルに結合していました。
その時の結合するVBAを紹介したいと思いますので
ぜひ活用してみて下さい！！

コードの内容

Option Explicit
Sub csvを結合()
    Const ForReading   As Long = 1
    Const TristateAnsi As Long = 0   ' ANSI（Shift-JIS）で読み込み
    Dim fso        As Object
    Dim fld        As Object
    Dim fil        As Object
    Dim ts         As Object
    Dim wbMaster   As Workbook
    Dim ws         As Worksheet
    Dim FolderPath As String
    Dim TimeStamp  As String
    Dim SaveName   As String
    Dim line       As String
    Dim arr        As Variant
    Dim rowIndex   As Long
    Dim lineCount  As Long
    Dim firstFile  As Boolean
    Dim j          As Long
    Dim MaxCols    As Long
    Dim stm        As Object
    Dim i          As Long
    Dim lineOut    As String
    Dim cellVal    As Variant
    '―――――――――――――――――――――――
    ' 1. フォルダ選択
    '―――――――――――――――――――――――
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "CSVファイルが入ったフォルダを選択してください"
        If .Show <> -1 Then Exit Sub
        FolderPath = .SelectedItems(1)
    End With
    '―――――――――――――――――――――――
    ' 2. パフォーマンス最適化
    '―――――――――――――――――――――――
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    '―――――――――――――――――――――――
    ' 3. マスター用ワークブック＆シート準備
    '―――――――――――――――――――――――
    Set wbMaster = Workbooks.Add(xlWBATWorksheet)
    Set ws = wbMaster.Sheets(1)
    ws.Name = "MergedData"
    ' 全セルを文字列扱いに設定 → E表記・桁落ち防止
    ws.Cells.NumberFormat = "@"
    rowIndex = 1
    firstFile = True
    MaxCols = 0
    '―――――――――――――――――――――――
    ' 4. FSOでCSVをテキスト読み込み＆マージ
    '―――――――――――――――――――――――
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(FolderPath)
    For Each fil In fld.Files
        If LCase(fso.GetExtensionName(fil.Name)) = "csv" Then
            Set ts = fil.OpenAsTextStream(ForReading, TristateAnsi)
            lineCount = 0
            Do While Not ts.AtEndOfStream
                line = ts.ReadLine
                lineCount = lineCount + 1
                arr = Split(line, ",")
                ' 最初のファイル１行目で列数を記憶
                If firstFile And lineCount = 1 Then
                    MaxCols = UBound(arr) + 1
                End If
                ' 最初のファイルはヘッダー＋全行、
                ' ２つ目以降は２行目以降のみを取り込む
                If firstFile Or lineCount > 1 Then
                    For j = 0 To UBound(arr)
                        ws.Cells(rowIndex, j + 1).Value = arr(j)
                    Next j
                    ' 列数揃えのため空セルも埋める
                    If UBound(arr) + 1 < MaxCols Then
                        For j = UBound(arr) + 1 To MaxCols - 1
                            ws.Cells(rowIndex, j + 1).Value = ""
                        Next j
                    End If
                    rowIndex = rowIndex + 1
                End If
            Loop
            ts.Close
            firstFile = False
        End If
    Next
    '―――――――――――――――――――――――
    ' 5. 設定を元に戻す
    '―――――――――――――――――――――――
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    '―――――――――――――――――――――――
    ' 6. 保存ファイル名作成
    '―――――――――――――――――――――――
    TimeStamp = Format(Now, "yyyymmdd_HHmmss")
    SaveName = "結合済みcsv_" & TimeStamp & ".csv"
    '―――――――――――――――――――――――
    ' 7. ADODB.StreamでUTF-8 BOM付きCSVを書き出し
    '―――――――――――――――――――――――
    On Error Resume Next
    Set stm = CreateObject("ADODB.Stream")
    On Error GoTo 0
    If Not stm Is Nothing Then
        With stm
            .Type = 2               ' adTypeText
            .Charset = "utf-8"
            .Open
            For i = 1 To rowIndex - 1
                lineOut = ""
                For j = 1 To MaxCols
                    cellVal = ws.Cells(i, j).Value
                    lineOut = lineOut & CStr(cellVal)
                    If j < MaxCols Then lineOut = lineOut & ","
                Next j
                .WriteText lineOut & vbCrLf
            Next i
            .Position = 0
            .SaveToFile FolderPath & "\" & SaveName, 2  ' adSaveCreateOverWrite
            .Close
        End With
    Else
        ' ADODB.Stream が使えない場合は Shift-JIS で保存
        ws.Parent.SaveAs FileName:=FolderPath & "\" & SaveName, _
                         FileFormat:=xlCSV, Local:=True
    End If
    '―――――――――――――――――――――――
    ' 8. マージ用ワークブックを閉じる
    '―――――――――――――――――――――――
    wbMaster.Close SaveChanges:=False
    '―――――――――――――――――――――――
    ' 9. 完了メッセージ
    '―――――――――――――――――――――――
    MsgBox "【完了】CSVを統合して保存しました：" & vbCrLf & _
           FolderPath & "\" & SaveName, vbInformation
End Sub

処理の内容

1. フォルダ選択
• ユーザーにCSVファイルが入っているフォルダを選ばせる。
2. パフォーマンス最適化
• 画面更新やイベント処理を一時停止し、高速処理に切り替える。
3. マスターブック準備
• 新しいExcelブックを作成し、データ統合用のシートを作る。
• セル形式を「文字列」にして、数値が勝手に変換されないようにする。
4. CSVファイルの読み込み＆結合
• FSO（FileSystemObject）を使ってCSVファイルを1行ずつ読み込み。
• 最初のCSVだけヘッダーを取り込み、以降は2行目以降のみ結合。
• 列数が異なるCSVも対応。列数を合わせて整形。
5. Excel設定を元に戻す
• 最適化を解除し、通常のExcel動作に戻す。
6. 保存ファイル名の生成
• タイムスタンプ付きのファイル名を生成。
7. UTF-8（BOM付き）で保存
• ADODB.Streamを使ってCSVファイルとして出力。
• もしADODBが使えない場合は、Shift-JIS形式で保存。
8. Excelファイルを閉じる
• 作業用のマスターブックは保存せずに閉じる。
9. 完了メッセージ表示
• 保存場所とファイル名を表示して処理完了を知らせる。

⸻

補足ポイント

• Shift-JIS対応：入力ファイルの読み込み時はShift-JIS（ANSI）で開いている。
• 文字化け防止：出力はUTF-8（BOM付き）なので、Excelや他のツールで文字化けしにくい。
• 安全性と汎用性：ADODB.Streamが使えなくても代替手段があるので実用性高い。