VBA

【VBA】設定不要でテーブルを結合(マージ)する関数(コピペですぐ使える)

記事内に商品プロモーションを含む場合があります

こんにちは、hokkyokunです。

エクセルのテーブルを結合する関数を作りました。
ポイントは以下です。

  • 面倒な設定(SQLの環境構築、参照設定等)が一切要らない
  • 本ページの関数と
    配列に関する関数をコピペすればすぐ使える

VBAは便利なのですが、
Pythonなど他の言語に比べて見劣りする部分も結構あり、
その一つがテーブル、データフレーム編集のパッケージの弱さです

PythonであればSQLなどのデータベース管理も簡単だし、
そもそもPandasというテーブル(正確にはデータフレーム)を簡単に加工する手法も確立しています。

VBAはテーブルを結合する方法は基本的にはないので
自作しました。ほんと、簡単に使えます

関数

  • 関数名
    merge_Table( tableL , tableR , on_ , how )
  • 引数
    ① tableL : 一つ目のテーブル(データ型はテーブル)
    ② tableR : 二つ目のテーブル(データ型はテーブル)
    ③ on_  : キーとなる列名(データ型はString)
    ④ how : 結合様式(データ型はstring)
  • 戻り値
    結合後のテーブル
Function merge_Table(ByVal tableL As ListObject, ByVal tableR As ListObject, ByVal on_ As String, ByVal how As String)
    Dim ws As Worksheet
    Dim Headers, HeadersR As Variant
    Dim r As Range
    Dim rr As Range
    Dim i, j, k As Long
    Dim header As Variant
    Dim result As ListObject
    
    '''''①マージ後のテーブルを置くシートを作る
    Set ws = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))

    '''''②マージ後のヘッダーを作る
    '先ずtableLの見出しを格納し、そこにtableRの見出しのうち、
    'キーとなる列を除いて格納する
    
    'tableLの見出しを格納
    For Each r In tableL.HeaderRowRange
        Call add_Elm(Headers, r.Value)
    Next
    
    'tableRの見出しをを格納
    '後でtableRのヘッダーを初期値に戻すために記録しておく
    For Each r In tableR.HeaderRowRange
        Call add_Elm(HeadersR, r.Value)
    Next
    
    'キーとなる列は追加しない
    '文字列がかぶっている列名は「〇〇_R」と付ける
    For i = 1 To tableR.ListColumns.Count
        If Is_exist_same_Elm(Headers, tableR.ListColumns(i)) Then
            If Not tableR.ListColumns(i) = on_ Then
                Call add_Elm(Headers, tableR.ListColumns(i) & "_R")
                
                'tableRの列名を「〇〇_R」に変える
                '後々値を格納するためにtableRとマージ後のテーブルの見出しを合わせる
                tableR.HeaderRowRange(i).Value = tableR.ListColumns(i) & "_R"
                
            End If
        Else
            Call add_Elm(Headers, tableR.ListColumns(i))
        End If
    Next

    ''''''③マージ後のheaderをシートに転記する
    
    i = 1
    For Each header In Headers
        ws.Cells(1, i).Value = header
        i = i + 1
    Next

    Set result = ws.ListObjects.Add(xlSrcRange, ws.Cells(1, 1).CurrentRegion, , xlYes)

    'レコード(値)を打っていく
    '"inner":table_Lとtable_R両方にある行のみ転記
    '"left" :table_Lの行は全て転記、キーがあるtable_Rを結合させる
    '"right" :table_Rの行は全て転記、キーがあるtable_Lを結合させる
    '値を打つコードは冗長になるので「post_datas」という関数を作って別で管理
    Select Case how
        Case "inner"
            'tableLを上から順に一つ一つ読んでいく
            'その一つ一つに対し、tableRの列を上から読んでいく
            'キーがかぶっている列は、マージ後のテーブルに転記する
            For j = 1 To tableL.ListRows.Count
                For k = 1 To tableR.ListRows.Count
                    If tableL.ListColumns(on_).DataBodyRange(j).Value = tableR.ListColumns(on_).DataBodyRange(k).Value Then
                        result.ListRows.Add
                        Call post_datas(result, tableL, j)
                        Call post_datas(result, tableR, k)
                    End If
                Next k
            Next j
            
        Case "left"
            'tableLは上から順に転記していく→必ずtableLは転記される
            'tableRはキーがかぶっていれば転記→かぶっていなければ転記されない
            For j = 1 To tableL.ListRows.Count
                result.ListRows.Add
                Call post_datas(result, tableL, j)
                For k = 1 To tableR.ListRows.Count
                    If tableL.ListColumns(on_).DataBodyRange(j).Value = tableR.ListColumns(on_).DataBodyRange(k).Value Then
                        Call post_datas(result, tableR, k)
                    End If
                Next
            Next j
        
        Case "right"
            '今度は逆にtableRを上から順に転記
            'tableLはキーがかぶっていれば転記
            For k = 1 To tableR.ListRows.Count
                result.ListRows.Add
                Call post_datas(result, tableR, k)
                For j = 1 To tableL.ListRows.Count
                    If tableL.ListColumns(on_).DataBodyRange(j).Value = tableR.ListColumns(on_).DataBodyRange(k).Value Then
                        Call post_datas(result, tableL, j)
                    End If
                Next
            Next
        
            
    End Select

    'tableRのヘッダーを初期値に戻す
    For i = 1 To tableR.ListColumns.Count
        tableR.HeaderRowRange(i).Value = HeadersR(i - 1)
    Next
    
    Set merge_Table = result
End Function

'result:マージ後のテーブル
'table:転記するテーブル
'Row:tableのうち転記する行を指定
Function post_datas(ByRef result As ListObject, ByVal table As ListObject, ByVal Row As Long)
    Dim i, j As Long
    Dim col_name As String
    Dim val_ As Variant
    
    For i = 1 To table.ListColumns.Count
        col_name = table.ListColumns(i)
        val_ = table.ListRows(Row).Range(i).Value
        
        For j = 1 To result.ListColumns.Count
            If result.ListColumns(j) = col_name Then
                result.ListRows(result.ListRows.Count).Range(j).Value = val_
                Exit For
            End If
        Next j
    Next i
End Function

本コードはかなり長くなりました。
少しでも短くするために当サイトで作成した配列の関数を使っています。

以下の配列をコピペしてご使用いただけますと幸いです。
(下記をクリックするとそれぞれコードが公開されているページに飛びます)

使い方

そもそも結合とはどういうこと?

Pythonのpandasにあるmerge関数を参考にして作ってあります。

具体的な例を使って説明させていただきます。
このような感じでテーブルを二つ作りました。

結合する際はよく、「左」、「右」と表現するので
青い方を「左テーブル」、オレンジを「右テーブル」とします。

テーブルの結合は「キー」となる列を選択します。
「キー」の値が同じ値の列を結合させる。というのが基本的な考え方です。

ここでは「名前」列がそれぞれキーとなります。

今回私が作った関数では
引数「on_」にキーとなる列名を文字列で指定して下さい。

ちなみに、キーの位置はどこでも大丈夫なように作っています。
テーブルの左端でも右端でも、真ん中でも大丈夫です。

結合様式(Inner)

結合の仕方には3種類あります。
まずはInnerから

Innerは左テーブルと右テーブルの
どちらもキーが存在する列のみを結合させる方法です。

引数「how」に「inner」と指定してください。

次のコードで使用してみます。

Sub test_inner()

Dim tableL, tableR As ListObject

Set tableL = ThisWorkbook.Worksheets(1).ListObjects("テーブルL")
Set tableR = ThisWorkbook.Worksheets(1).ListObjects("テーブルR")

Dim merged_Table As ListObject
Set merged_Table = merge_Table(tableL, tableR, on_:="名前", how:="inner")
End Sub

プログラムを実行すると
テーブルが新たに作成されたシートに生成されます。

左が結合前、右が結合後です。
赤で囲まれている列のみ生成されていることがわかります。

また、この関数は結合後のテーブルを戻り値として持つことができるので
この結合したテーブルをすぐに別のプログラムに使うことができます。

結合様式(Left)

結合のルールは同様です。
キーが同一の列同士を結合させます。
ただし、「左テーブル」の列は全て残します。

引数「how」に「left」と指定してください。

左の緑の部分が全て残るイメージです。

また、試してみます。

Sub test_left()

Dim tableL, tableR As ListObject

Set tableL = ThisWorkbook.Worksheets(1).ListObjects("テーブルL")
Set tableR = ThisWorkbook.Worksheets(1).ListObjects("テーブルR")

Dim merged_Table As ListObject
Set merged_Table = merge_Table(tableL, tableR, on_:="名前", how:="left")
End Sub

結合様式(Right)

結合のルールは同様です。
キーが同一の列同士を結合させます。
ただし、「右テーブル」の列は全て残します。

引数「how」に「right」と指定してください。

今度は右テーブルの緑の部分が全て残ります。
Sub test_right()

Dim tableL, tableR As ListObject

Set tableL = ThisWorkbook.Worksheets(1).ListObjects("テーブルL")
Set tableR = ThisWorkbook.Worksheets(1).ListObjects("テーブルR")

Dim merged_Table As ListObject
Set merged_Table = merge_Table(tableL, tableR, on_:="名前", how:="right")
End Sub

列名がかぶっていたとき

以上で基本的な説明は終わりなのですが、
「左テーブル」と「右テーブル」で列名がかぶっている場合があるかもしれません。

その場合は「右テーブル」のかぶっている列名の後ろに「_R」とつける仕様にしました

これらを「inner」で結合させます。

まとめ

いかがでしたでしょうか。

関数名:merge_Table( tableL , tableR , on_ , how )

引数:
tableL:一つ目のテーブル「左テーブル」
tableR:二つ目のテーブル「右テーブル」
on_:キーとなる列名を文字列で指定
how:結合様式を選択 右のいずれかを文字列で指定 「inner」「left」「right」

VBAの学習方法をまとめました。

VBA(マクロ)のおすすめの学習方法 こんにちはhokkyokunです。 VBAを学ぶことで確実に業務は効率化し、余裕をもって仕事をすることができるようになります。 ...

VBAを高コスパで、短期間で学ぶにはUdemyがおすすめです。
Udemyは良質の学習プラットフォームですが、動画数が多すぎてどれを見ればよいか迷います。

おすすめの講師をまとめました。

【Udemyは講師で選べ!】UdemyがVBA学習に最適な理由とおすすめのVBA講師 こんにちはhokkyokunです。 巨大学習プラットホームUdemyの中からVBAに関する動画について講師に焦点を当ててまとめま...