Excelで異なるカラム構成のCSVを2つ読み込んで、共通のキーとなる値でデータを結合する

Excelで異なるカラム構成のCSVを2つ読み込んで、共通のキーとなる値でデータを結合する。

データベース的に異なるファイル同士の情報を結合したいケースってありますよね。

Excel馬鹿、って言葉が聞こえてこなくもないが、いろいろと課題満載のこのテーマ。

何とか解決したので、記録しておきたい。

※↓のファイルの各シートやコードを見ながらだと理解がスムーズだと思われる。

https://1drv.ms/u/s!AqGyTO4ulx7loiRR-K8FS5KiCriz?e=NX55sv

　→サンプルデータとマクロファイルセットになってます。

まずは状況の整理から。

【前提条件＝状況のまとめ】

筆者が直面した状況ではあるのだが次のような状況を仮定する。

1.システムAにユーザIDが存在。：ファイル①

2.システムBにユーザの属性情報が存在。：ファイル②

3.「1.」「2.」の前提で「2.」の属性情報をシステムAに定期的に同期したい。
※残念ながらREST APIやSAML認証は使用不可。。

4.システムA、Bともにデータの入出力はCSVで行われる。

5.それぞれのCSVは文字コードもバラバラだったりダブルクオーテーションでくくられてカラム内で改行が入っていたりと、割と取り扱い注意なCSVファイルである。

6.ファイル①とファイル②は相互に紐づけ可能なキー情報を保持しているが、フォーマット（CSVのカラム名や並び順等々）はバラバラである。

7.ファイル①とファイル②のカラム数やカラム名は今後変わる事がありうる（結合用のキー情報も必ず1行目とは限らず、変わる可能性がある）。

・・・だいぶ詰んでいる状況がお分かりだろうか。この手の話であればデータベースでやるのが王道だろうがAccessは常にインストールされているとは限らない。

Excel馬鹿の出番である！

【課題整理】

解決上記の状況より、解決しなければならない課題は次の通り。

①この件に限らないが動作パラメータはExcelシート上で作業員に更新できる様にしておきたい。

②文字コードが異なったり、ダブルクオーテーション「"」でくくられていたり、セル内改行がある様なCSVを正しく読み込まなければならない。

③ファイルのフォーマットが変わる前提で、列数とファイル①ファイル②の列の対応付けをハードコーディングしない作りにする必要がある。

では課題の整理はこの辺にして、解決編。

まず、動作パラメータの外だし。

①この件に限らないが動作パラメータはExcelシート上で作業員に更新できる様にしておきたい。

Params というシートにkey valueの列挙を行い、そいつをディクショナリオブジェクトとして連想配列的に取り込んで、プログラム内では名前で値を呼べる仕組みにすることとした。

コードは次のような感じ。

Public Params As Object
Sub ParamsLoader()
Dim i As Long
Set Params = CreateObject("Scripting.Dictionary")
    With Worksheets("Params")
        For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).row
            Params(.Cells(i, 2).Value) = .Cells(i, 3).Value
        Next i
    End With
End Sub

値を呼び出すときは「Params("key名")」って感じ。

パラメータ用シートのシート名や列数のハードコーディングは許してもらうしかないので良しとする。

お次の課題は、

②文字コードが異なったり、ダブルクオーテーション「"」でくくられていたり、セル内改行がある様なCSVを正しく読み込まなければならない。

これはかなり苦労した。

色々試したが、ダブルクオーテーションで囲まれた改行コードでデータが崩れたり、そもそもテキスト貼り付けではUTF-８が読めなかったり、と表計算なのにCSVが扱いにくいという大変な状況。。。

が世の中凄い人がいるもんで、↓こちらの方の記事が参考になった。

https://kamocyc.hatenablog.com/entry/2019/12/12/071856

結論としては私は「PowerQuery (取得と変換) を使う」を採用。引数でファイル名やdelimiter、文字コード、書き込み先シート情報を受け取るサブルーチンに改変した。

コードは次の通り。

Sub LoadCsv(csvPath As String, codePage As Long, delimiter_1char As String, targetSheet As Worksheet)
'call example
'Call LoadCsv("C:\CSV_MergeTool\InputFiles\data.csv", 65001, ",", ActiveSheet)

    
    Const kQueryName As String = "temp_csv_import_01"


    ' 一時ブックを作ってインポートし、そこから目的のセルへコピーする
    Dim wb As Workbook: Set wb = Application.Workbooks.Add()
    Dim ws As Worksheet: Set ws = wb.Worksheets(1)
    Dim tempDestination As Range: Set tempDestination = ws.Cells(1, 1)
    
    Dim mScript As String
    mScript = "Table.PromoteHeaders(Csv.Document(File.Contents(""" & csvPath & """), [Delimiter=""" & delimiter_1char & """, Encoding=" & codePage & ", QuoteStyle=QuoteStyle.Csv]), [PromoteAllScalars=true])"
    
    Dim wQuery As WorkbookQuery
    Set wQuery = wb.Queries.Add(Name:=kQueryName, Formula:=mScript)
    
    Dim qTable As QueryTable
    Set qTable = _
        ws.ListObjects.Add( _
            SourceType:=xlSrcExternal, _
            Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""" & kQueryName & """;Extended Properties=""""", _
            Destination:=tempDestination _
        ).QueryTable
    
    With qTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & kQueryName & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        'データが1万件とかになると↓でかなり重くなるので「.AdjustColumnWidth = False」にすると良い。
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = False
        .ListObject.DisplayName = "q" & kQueryName
        .Refresh BackgroundQuery:=False
    End With
    
    ' 目的のセルにコピー
    ws.UsedRange.Copy
    targetSheet.Range("A1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    Application.DisplayAlerts = False
    wb.Close False
    Application.DisplayAlerts = True
End Sub

③ファイルのフォーマットが変わる前提で、列数とファイル①ファイル②の列の対応付けをハードコーディングしない作りにする必要がある。

此方が今回のメイン処理。

マッピングの対応表はMappingシートに動作の基本的な変数はParamsに保存した上で、Mappingシートの対応通りに、new_master_dataを更新するロジックになる。

動作は動かして確認してほしい。

コードは次の通り。

Sub Step020_1on1Mapping()
'動作パラメータ読み込み
Call ParamsLoader

ActiveWorkbook.Worksheets(Params("output_master_datasheet")).Cells.Clear '既存データクリア

'タイトル行と主キー列（column_number_of_key_in_master_data）の複製
ActiveWorkbook.Worksheets(Params("org_master_data_sheet")).Columns(Params("column_number_of_key_in_master_data")).Copy ActiveWorkbook.Worksheets(Params("output_master_datasheet")).Columns(Params("column_number_of_key_in_master_data"))
ActiveWorkbook.Worksheets(Params("org_master_data_sheet")).Rows(1).Copy ActiveWorkbook.Worksheets(Params("output_master_datasheet")).Rows(1)

'転記先データの主キー不存在行の削除
Call DeleteBlankRows(Worksheets(Params("output_master_datasheet")))

Dim i As Long
i = 2

'転記先テーブルのキー情報が無くなるまで繰り返し
Do While Sheets(Params("output_master_datasheet")).Cells(i, Params("column_number_of_key_in_master_data")).Value <> ""

    '転記元テーブルのキー情報レンジを格納
    Dim source_data_key As Range
    Set source_data_key = Sheets(Params("source_data_sheet")).Columns(Params("column_number_of_key_in_source_data"))

    'Mapping情報ループ用変数
    Dim j As Long
    j = 2
    'Mapping情報格納用変数
    Dim src_col As Long
    Dim dst_col As Long

    'Mapping情報が無くなるまで繰り返し
    Do While Sheets(Params("mapping_data_sheet")).Cells(j, 3).Value <> ""
        src_col = Sheets(Params("mapping_data_sheet")).Cells(j, 3).Value
        dst_col = Sheets(Params("mapping_data_sheet")).Cells(j, 4).Value
    
        'Match関数はマッチしないとエラー吐くので、Resume Next。
        On Error Resume Next
        
        With Application.WorksheetFunction
            '代入処理
            Sheets(Params("output_master_datasheet")).Cells(i, dst_col).Value = _
            Sheets(Params("source_data_sheet")).Cells(.Match(Sheets(Params("output_master_datasheet")).Cells(i, Params("column_number_of_key_in_master_data")).Value, source_data_key, 0), src_col).Value
        End With
        'Match関数はマッチしないとエラー吐くので、Resume Nextしたのを解除。
        On Error GoTo 0
        
        j = j + 1
    Loop

    i = i + 1
Loop

End Sub

その他に、ファイル①とファイル②でお互いの情報が完全に同じキーの組み合わせでは無かったりファイル①にはキーとなる値が存在しないデータも紛れ込んでいたりする前提もあったため、ファイル①の情報はmergeに掛ける前に、キーとなる値が存在しない行は削除する、という処理を行っている。

データのない行を削除するという書き方は↓こちらの方の記事が良かった。

https://www.moug.net/tech/exvba/0050065.html

こちらも、引数でワークシートを指定させるサブルーチンに書き換えている。

まとめ

という事で3日近くかかりっきりで何とかある程度汎用的に使える仕組みに出来上がったと思うのでここに残しておく。

くれぐれも、DBでやれば？とは言わないでいただきたい。