複数のCSVをマージ（結合）してエクセルに表示 - コピペでVBA(Excel)

こちらの記事はエクセルVBAをあまり知らない方でも利用できる「コピペでVBA(Excel)」としてもご活用できます。詳しくはこちらをご確認ください。

「コピペでVBA(Excel)」とは？エクセルVBAの知識がない人でもコードをコピペするだけで便利な処理が使えることを目指しています。汎用性のありそうなコードを順次公開していき

2018-02-12 14:00

複数のCSVをマージ（結合）する - マクロ解説

このコードを実行すると、任意のフォルダ内にあるCSVファイルを全て読み込んでエクセルファイルに書き出します。フォルダ内にあるCSV以外のファイルは無視されます。エクセルファイルは新しいブックが生成され、そこにデータが書き出されるようになっています。また、A列にはCSVファイル名を記載するようになっているので、なにか気になることがあってもどのCSVファイルのデータかわかるようになります。

複数のCSVをマージ（結合）するマクロのコード

Private Sub CSV()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim buf, path, ws As Workbook, LastCell As Range, cnt As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            path = .SelectedItems(1)
        End If
    End With

    If path = "" Then End
    
    Workbooks.Add
    Set ws = ActiveWorkbook
    
    path = path & "\"
    buf = Dir(path & "*.csv")
    Do While buf <> ""
        cnt = cnt + 1
            Workbooks.Open Filename:=path & buf, UpdateLinks:=True, ReadOnly:=True
            Set LastCell = Cells.SpecialCells(xlCellTypeLastCell)
            
            If cnt = 1 Then
                Range(Cells(1, 1), LastCell).Copy
                With ws.ActiveSheet
                    .Range("B1").PasteSpecial
                    .Range("A1") = "ファイル名"
                    .Range("A2:A" & .Cells.SpecialCells(xlCellTypeLastCell).Row & "") = buf
                End With
            Else
                Range(Cells(1, 1), LastCell).Copy
                With ws.ActiveSheet
                    .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row + 1, 2).PasteSpecial
                    .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":A" & .Cells.SpecialCells(xlCellTypeLastCell).Row & "") = buf
                End With
            End If
            
            ActiveWorkbook.Close
        buf = Dir()
    Loop
    Range("A1").Select
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

※コードをコピーする時は、右上のアイコンをクリックしてください

このマクロを使う理由

機械的に出力されるデータやログは複数のCSVになることが多いです。それらを集計したり一覧で確認したりする場合は、やはりひとつのデータにしたいです。その際にひとつずつ開いて結合するのは非常に手間です。そういった場合に対象のCSVファイルを任意のフォルダの中にまとめて、このマクロを実行するとエクセルファイルにデータが結合されます。

プラスワン

同じフォーマットになったCSV（とりわけ表になっているもの）は見出し（ヘッダー）が特定の位置にあり、その見出しも含めて統合すると使い勝手が良くない場合があります。そこで、2つ目以降のCSVファイルは見出しを取得しないようにするマクロを用意しました。どのCSVでも見出し行が同じであることが条件です。最初に見出しの行番号が聞かれるので、数字で行番号を指定してください。

Private Sub CSV_HeadLine()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim buf, path, ws As Workbook, HeadLine As String, LastCell As Range, cnt As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            path = .SelectedItems(1)
        End If
    End With

    If path = "" Then End
    HeadLine = InputBox("見出しの行番号を入力してください")
    
    Workbooks.Add
    Set ws = ActiveWorkbook
    
    path = path & "\"
    buf = Dir(path & "*.csv")
    Do While buf <> ""
        cnt = cnt + 1
            Workbooks.Open Filename:=path & buf, UpdateLinks:=True, ReadOnly:=True
            Set LastCell = Cells.SpecialCells(xlCellTypeLastCell)
            
            If cnt = 1 Then
                Range(Cells(HeadLine, 1), LastCell).Copy
                With ws.ActiveSheet
                    .Range("B1").PasteSpecial
                    .Range("A1") = "ファイル名"
                    .Range("A2:A" & .Cells.SpecialCells(xlCellTypeLastCell).Row & "") = buf
                End With
            Else
                Range(Cells(HeadLine + 1, 1), LastCell).Copy
                With ws.ActiveSheet
                    .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row + 1, 2).PasteSpecial
                    .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":A" & .Cells.SpecialCells(xlCellTypeLastCell).Row & "") = buf
                End With
            End If
            
            ActiveWorkbook.Close
        buf = Dir()
    Loop
    Range("A1").Select
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

※コードをコピーする時は、右上のアイコンをクリックしてください