【Excel VBA】2つの表を1つにまとめる

田中太郎
田中太郎

2つの表を1つにまとめるマクロです

概要

キーワードと値の表が2つある。
表1のキーワードが表2にもあるとき、表2の値を表1に記入する

入力

Sheet2 に図1の表が書き込まれています。A列がキーワード、B列が値です。

図1: sheet2

Sheet1に図2の表が書き込まれています。A 列がキーワードです。

図2: Sheet1

マクロを実行すると、Sheet1のB列にSheet2のキーワードと同じ値が書き込まれます。

出力

図3: 実行結果

コード

Sub merge_2table()
    
    'User difinitions
    Dim sheet_from As String
    Dim sheet_to As String
    sheet_from = "sheet2"
    sheet_to = "sheet1"
    
    'loop variables
    Dim i As Integer
    Dim j As Integer
    
    Dim k_word() As String
    Dim v_word() As String
    ReDim v_word(Worksheets(sheet_from).Cells(Rows.Count, 1).End(xlUp).Row)
    ReDim k_word(Worksheets(sheet_from).Cells(Rows.Count, 1).End(xlUp).Row)
    
    For i = 1 To Worksheets(sheet_from).Cells(Rows.Count, 1).End(xlUp).Row
        k_word(i) = Worksheets(sheet_from).Cells(i, 1)
        v_word(i) = Worksheets(sheet_from).Cells(i, 1 + 1)
    Next

    For i = 1 To Worksheets(sheet_to).Cells(Rows.Count, 1).End(xlUp).Row
        For j = 1 To Worksheets(sheet_from).Cells(Rows.Count, 1).End(xlUp).Row
            If k_word(j) = Worksheets(sheet_to).Cells(i, 1) Then
                Worksheets(sheet_to).Cells(i, 1 + 1) = v_word(j)
            End If
        Next j
    Next i
    
End Sub

備考

コードの13~16行目は4行→2行にできますが、拡張性を持たせるため4行で書いています。

コメント

タイトルとURLをコピーしました