【Excel VBA】複数のCSVファイルを結合して取り込む方法

複数のCSVファイルを結合して取り込む方法をについて説明していきます。

コード

複数のCSVファイルを結合し、指定したシートへ出力するコードです。

ヘッダを基準に結合処理を行っているため以下の状況に対応できます。

• ヘッダの列数が異なる
• ヘッダの列位置が異なる
• ヘッダの列名が異なる

'---複数のCSVを結合して指定シートに出力する---
Public Sub CsvMultiImport(ByVal fileList As Collection, ByRef outSheetObj As Worksheet)
    '定義
    Const outTiming = 1000 '一度にシートへ出力するデータ件数
    '宣言
    Dim outData() As Variant
    ReDim outData(1 To outTiming, 1 To 1)
    Dim outDataCount As Long: outDataCount = 1
    Dim sheetOutCount As Long: sheetOutCount = 1
    Dim outColumnList As New Dictionary
    Dim csvData As Variant
    Dim filePath As Variant
    Dim csvColumnList() As Variant
    Dim i As Long
    Dim j As Long
    'CSVを取り込む
    For Each filePath In fileList
        csvData = csvLode(filePath)
        If IsEmpty(csvData) Then GoTo Skip
        If UBound(csvData) < 2 Then GoTo Skip
         'CSVヘッダを取得する
        ReDim csvColumnList(1 To UBound(csvData, 2))
        For i = 1 To UBound(csvData, 2)
            If Not outColumnList.Exists(csvData(1, i)) Then
                outColumnList.Add (csvData(1, i)), UBound(outData, 2)
                ReDim Preserve outData(1 To outTiming, 1 To UBound(outData, 2) + 1)
            End If
            csvColumnList(i) = outColumnList(csvData(1, i))
        Next
        For i = 2 To UBound(csvData)
           '出力配列へCSVデータ格納
            For j = 1 To UBound(csvColumnList)
                outData(outDataCount, csvColumnList(j)) = csvData(i, j)
            Next
            '出力配列が満タンの場合はCSVデータを出力
            If outDataCount = UBound(outData) Then
                With outSheetObj
                    .Range(.Cells(outTiming * (sheetOutCount - 1) + 2, 1), _
                    .Cells(outTiming * sheetOutCount + 1, UBound(outData, 2) - 1)) = outData
                End With
                sheetOutCount = sheetOutCount + 1
                outDataCount = 0
            End If
            outDataCount = outDataCount + 1
        Next
Skip:
    Next
    'ヘッダと残りのデータを出力
    With outSheetObj
        .Range(.Cells(1, 1), .Cells(1, outColumnList.Count)) = outColumnList.Keys
        .Range(.Cells(outTiming * (sheetOutCount - 1) + 2, 1), _
        .Cells(outTiming * (sheetOutCount - 1) + outDataCount, UBound(outData, 2) - 1)) = outData
    End With
End Sub

'---CSVを読み込む---
Private Function csvLode(ByVal filePath As String, Optional ByVal encode As Long = 932) As Variant
    'PowerQueryでCSVを読み込む
    Dim sheetObj As Worksheet
    Set sheetObj = Worksheets.Add
    ActiveWorkbook.Queries.Add Name:="data", Formula:= _
    "let" & Chr(13) & "" & Chr(10) & "    source = Csv.Document(File.Contents(""" & filePath & """),[Delimiter="","",Encoding=" & encode & ", QuoteStyle=QuoteStyle.None])," _
    & Chr(13) & "" & Chr(10) & "    header = Table.PromoteHeaders(source, [PromoteAllScalars=true])" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    header"
    With sheetObj.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=data;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [data]")
        .RefreshStyle = xlInsertDeleteCells
        .Refresh BackgroundQuery:=False
    End With
    csvLode = sheetObj.Range("A1").ListObject.Range
    '一時シート削除
    Application.DisplayAlerts = False
    ActiveWorkbook.Queries(1).Delete
    sheetObj.Delete
    Application.DisplayAlerts = True
End Function

使用例

CSVファイルの「Data1.csv」～ 「Data10.csv」を結合し、新規シートへ出力するサンプルです。

Private Sub test()
    Application.ScreenUpdating = False
    Dim fileList As New Collection
    Dim i As Long
    For i = 1 To 10
        fileList.Add "C:\Data\Data" & i & ".csv"
    Next
    Call CsvMultiImport(fileList, Worksheets.Add)
    Application.ScreenUpdating = True
End Sub

制約

以下のCSVは取り込めません。

• 1行目にヘッダがない。
• ヘッダの列名が重複している。