EXCEL VBA ２つのデータを検索・照合・結合・データを追記方法・重複データの検出・一意データに纏める（テクニック２）

2021年11月13日

EXCEL VBA ２つのデータを検索・照合・結合・データを追記方法・重複データの検出・一意データに纏める（テクニック２）

●はじめに

今回説明するのは、２つのデータを検索・照合して社員データに無いデータを追記するサンプルプログラムです。また、２つのデータを比較・照合して重複データを検出するサンプルプログラムも説明を致します。一意のデータ（ユニークデータ）を作成する際には、とても便利だと思います。以前、同じ内容のプログラムを紹介しましたが、今回の方がシンプルで分かり易いと思います。それでは、順番にサンプルプログラムを交えて順番に説明いたします。

●【２つのデータを検索・照合・データを追記する方法については、下記の情報を参照して下さい】（前回紹介プログラム）

EXCEL VBA ２つのデータを検索・照合・データを追記方法（テクニック）

●【Range.Find メソッド (Excel VBA)、下記の参照して下さい】※参考資料

https://docs.microsoft.com/ja-jp/office/vba/api/excel.range.find

EXCEL VBA テクニック　２つのデータを検索・照合して元データに無いデータを追記します。

●プログラム説明　(サンプル①）

下記のサンプルプログラムは、2つのデータを検索・照合して元データに無いデータを追記するサンプルプログラムです。A列に「勘定科目」一覧が表示されています。D列には、追記対象のデータ一覧が表示されています。このデータを照合してA列の「勘定科目」に無いデータを追記するサンプルプログラムです。

【プログラムの流れ】
①　A列の最終行を取得します。（元データ）
②　D列の最終行を取得します。（追記対象データ）
③　追記行を求める（A列最終行＋１）
④　A列全てに対してD列の追記対象データを1件ずつ照合する。
⑤　データが無ければ追記対象データをA列（元データ）の最終行に追記します。
⑥　A列の追記行＋１を加算する。

【プログラム実行条件】
①　A列に元データを入力する（一意のデータ）
②　B列に追記データ入力する（重複データ可能）

'
'
Sub Tusiki01() ''2つのデータを比較照合して、元データに無いデータを追記


    Dim I, L, lRow, mRow As Long
    Dim CheckCells As Range
    
    With ActiveSheet
    
        lRow = .Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を取得します。（元データ）
        mRow = .Cells(Rows.Count, "D").End(xlUp).Row 'D列の最終行を取得します。（追記対象データ）
    
        L = lRow + 1  '追記行を求める（A列最終行＋１）
    
        For I = 2 To mRow  '追記対象データ分繰り返す（最終行まで）
    
            Set CheckCells = .Range("A:A").Find(.Cells(I, "D"))  'A列全てに対してD列の追記対象データを1件ずつ照合する。
        
            If CheckCells Is Nothing Then  'データが無ければ追記対象データをA列の最終行に追記します
                .Cells(L, "A") = .Cells(I, "D")
                L = L + 1  'A列の追記行に＋１を加算する。
            End If
        Next I
    
    End With

End Sub
'

Sub Tusiki01() ''2つのデータを比較照合して、元データに無いデータを追記

Dim I, L, lRow, mRow As Long

Dim CheckCells As Range

With ActiveSheet

lRow = .Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を取得します。（元データ）

mRow = .Cells(Rows.Count, "D").End(xlUp).Row 'D列の最終行を取得します。（追記対象データ）

L = lRow + 1 '追記行を求める（A列最終行＋１）

For I = 2 To mRow '追記対象データ分繰り返す（最終行まで）

Set CheckCells = .Range("A:A").Find(.Cells(I, "D")) 'A列全てに対してD列の追記対象データを1件ずつ照合する。

If CheckCells Is Nothing Then 'データが無ければ追記対象データをA列の最終行に追記します

.Cells(L, "A") = .Cells(I, "D")

L = L + 1 'A列の追記行に＋１を加算する。

End If

Next I

End With

End Sub

●実行前～実行後　※プログラム実行後、A列の「勘定科目」とD列の「追記対象」と比較してA列の「勘定科目」一覧データに無い、勘定科目データが追記（追加）されました。
（画面クリックして拡大）

EXCEL VBA テクニック　２つのデータを比較・照合して元データに重複データが有れば、チェックマーク「＊」を付ける。

●プログラム説明　(サンプル②）

下記のサンプルプログラムは、2つのデータを比較・照合してお互いに重複データが有れば、チェックマーク「＊」を付けるサンプルプログラムです。A列の「都道府県」データとE列の「都道府県」データを比較して、重複しているデータに対して該当データのセル横にチェックマーク「＊」を付けます。

【プログラムの流れ】
①　E列の最終行を取得します。
②　E列の最終行まで繰り返します。
③　A列の「都道府県」データとE列の「都道府県」データと一件づつ検索します。
④　重複しているデータがあれば、該当データに、チェックマークを表示します。”＊”
⑤　E列のデータの最終行まで繰り返します。②へ

【プログラム実行条件】
①　A列に元データを入力する（一意のデータ）
②　B列に追記データ入力する（重複データ可能）

'
'
Sub Tusiki02() '2つのデータを比較照合して、重複データにチェックマークを付ける。

    Dim I, lRow As Long
    Dim CheckCells As Range
    
    lRow = Cells(Rows.Count, "E").End(xlUp).Row 'E列の最終行を取得します。
                      
    With ActiveSheet
    
        For I = 2 To lRow 'E列の最終行まで繰り返します。
        
            Set CheckCells = Range("A:A").Find(Cells(I, "E")) 'A列の「都道府県」データとE列の「都道府県」データと一件づつ検索します。
            
            If Not CheckCells Is Nothing Then  '重複しているデータがあれば、該当データに、チェックマークを表示します。
                .Cells(CheckCells.Row, "B") = "*"  'B列にチェックマークを表示します。
                .Cells(I, "F") = "*"  'F列にチェックマークを表示します。
            End If
            
        Next I
    
    End With
    

End Sub
'

Sub Tusiki02() '2つのデータを比較照合して、重複データにチェックマークを付ける。

Dim I, lRow As Long

Dim CheckCells As Range

lRow = Cells(Rows.Count, "E").End(xlUp).Row 'E列の最終行を取得します。

With ActiveSheet

For I = 2 To lRow 'E列の最終行まで繰り返します。

Set CheckCells = Range("A:A").Find(Cells(I, "E")) 'A列の「都道府県」データとE列の「都道府県」データと一件づつ検索します。

If Not CheckCells Is Nothing Then '重複しているデータがあれば、該当データに、チェックマークを表示します。

.Cells(CheckCells.Row, "B") = "*" 'B列にチェックマークを表示します。

.Cells(I, "F") = "*" 'F列にチェックマークを表示します。

End If

Next I

End With

End Sub

●実行前～実行後　※プログラム実行後、A列の「都道府県」とE列の「都道府県（比較）」とデータを比較して、お互いに重複しているデータにチェックマーク「＊」が表示されました。
（画面クリックして拡大）

EXCEL VBA テクニック　別々のシートにある２つのデータを検索・照合して元データに無いデータを追記します。

●プログラム説明　(サンプル③）

下記のサンプルプログラムは、別々のシートにある2つのデータを検索・照合して元データに無いデータを追記するサンプルプログラムです。今回のサンプルプログラムは、上記サンプルプログラム①の応用になります。シート「元データ」には、勘定科目一覧が表示されています。シート「追加」には、別の勘定科目一覧が表示されています。この別々のシートに分けれている勘定科目データをシート「元データ」に一意のデータとして纏めるサンプルプログラムです。

【プログラムの流れ】
①　シート「元データ」A列の最終行を取得します。
②　シート「追加」A列の最終行を取得します。
③　追記行を求める（A列最終行＋１）
④　シート「元データ」A列全てに対して、シート「追加」A列の追記対象データを1件ずつ照合する。
⑤　シート「元データ」に無ければ追記対象データA列の最終行に追記します。
⑥　A列の追記行＋１を加算する。

【プログラム実行条件】
①　ワークシート「元データ」を作成して、A列に元データを入力する（一意のデータ）
②　ワークシート「追加」を作成して、A列に追記データ入力する（重複データ可能）

'
'
Sub Tusiki03() '追記'別のシートから追記
    
    Dim ws01, ws02 As Worksheet
    Dim I, L, lRow, mRow As Long
    Dim CheckCells As Range
    
    Set ws01 = Worksheets("元データ")
    Set ws02 = Worksheets("追加")
    
    lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row     'A列の最終行を取得します。（元データ）
    mRow = ws02.Cells(Rows.Count, "A").End(xlUp).Row     'A列の最終行を取得します。（追加）
    
    L = lRow + 1  '追記行を求める（A列最終行＋１）

    For I = 2 To mRow  '追記対象データ分繰り返す（最終行まで）

        Set CheckCells = ws01.Range("A:A").Find(ws02.Cells(I, "A"))           'A列全てに対してD列の追記対象データを1件ずつ照合する。
    
        If CheckCells Is Nothing Then  'データが無ければ追記対象データをA列の最終行に追記します。
            ws01.Cells(L, "A") = ws02.Cells(I, "A")
            L = L + 1  'A列の追記行に＋１を加算する。
        End If
    Next I
        
        
End Sub
'

Sub Tusiki03() '追記'別のシートから追記

Dim ws01, ws02 As Worksheet

Dim I, L, lRow, mRow As Long

Dim CheckCells As Range

Set ws01 = Worksheets("元データ")

Set ws02 = Worksheets("追加")

lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を取得します。（元データ）

mRow = ws02.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を取得します。（追加）

L = lRow + 1 '追記行を求める（A列最終行＋１）

For I = 2 To mRow '追記対象データ分繰り返す（最終行まで）

Set CheckCells = ws01.Range("A:A").Find(ws02.Cells(I, "A")) 'A列全てに対してD列の追記対象データを1件ずつ照合する。

If CheckCells Is Nothing Then 'データが無ければ追記対象データをA列の最終行に追記します。

ws01.Cells(L, "A") = ws02.Cells(I, "A")

L = L + 1 'A列の追記行に＋１を加算する。

End If

Next I

End Sub

●実行前～実行後　※プログラム実行後、シート「元データ」A列の「勘定科目」とシート「追加」A列の「追記対象」と比較してシート「元データ」A列の「勘定科目」に無いデータが追記されました。
（画面クリックして拡大）

EXCEL VBA テクニック　複数のセルデータを比較・照合してデータ一覧にデータが無ければ、該当データを追記する。

●プログラム説明　(サンプル④）

下記のサンプルプログラムは、複数のセルデータを比較・照合してデータ一覧にデータが無ければ、該当データを追記するサンプルプログラムです。今回のサンプルプログラムでは、シート「社員データ」①とシート「社員追加データ」②を比較・照合しますが、複数のセルデータをA列～G列までのデータ１つのセルに纏めることで、複数セルの比較・照合を一括に処理する事ができます。このデータをシート「Work」にA列は、「社員データ」・B列は、「社員追加データ」作成する事で１対１のデータとして纏めて比較処理を行う事ができます。

【処理の流れ】
①　シート「社員データ」・・元となる社員データがA列～G列「社員番号、氏名、年齢・・・」と登録されています。（下記：図①）
②　シート「社員追加データ」・・社員追加データこのデータ内に、社員データに登録されていないデータが2件あります。（下記：図②）※黄色枠

③　シート「Work」・・A列にシート「社員データ」のA列～G列の結合データが代入します。（上記：図③）
シート「Work」・・B列にシート「社員追加データ」のA列～G列の結合データが代入します。

④　シート「社員データ」の最終行に、「社員データ」に無いデータが追加登録されました。（上記：図④）

【プログラムの流れ】
①　シート「社員データ」A列の最終行を取得します。※このデータは、追記を求める時にも使います。
②　シート「社員追加データ」A列の最終行を取得します。
③　シート「社員データ」のA列～G列のデータを結合して、シート「Work」A列に転記します。（データ全て）
④　シート「社員追加データ」のA列～G列のデータを結合して、シート「Work」B列に転記します。（データ全て）
⑤　シート「社員データ」A列の最終行＋１を加算する。（追記行を求める）
⑤　シート「Work」のA列・B列を比較・照合してデータが無ければシート追記します。既存データがあればそのまま
⑥　シート「社員追加データ」分のデータを全てを繰り返します。⑤へ戻る

【プログラム実行条件】
①　ワークシート「社員データ」を作成してA列～G列の人事データを作成します。（一意のデータ）
②　ワークシート「社員追加データ」を作成してA列～G列の人事データを作成します。（一部追加データ）

'
'
Sub Tusiki04()  '追記'別のシートから追記（複数データを追記）
    
    Dim ws01, ws02, ws03 As Worksheet
    Dim I, L, lRow, mRow As Long
    Dim CheckCells, TempCells, MultiCells As Range
    
    Set ws01 = Worksheets("社員データ")
    Set ws02 = Worksheets("社員追加データ")
    Set ws03 = Worksheets("Work")
    
    lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row     'A列の最終行を取得します。（社員データ）
    mRow = ws02.Cells(Rows.Count, "A").End(xlUp).Row     'A列の最終行を取得します。（社員追加データ）
    
    
    For I = 2 To lRow  'シート「社員データ」の最終行まで繰り返します。
      TempCells = ""
      
      For Each MultiCells In Range(ws01.Cells(I, 1), ws01.Cells(I, 7)) '社員データのA列～G列のデータを結合します。
          TempCells = TempCells & MultiCells.Text & ""
      Next MultiCells
      
      ws03.Cells(I, "A").Value = TempCells  '結合したデータをシート「Work」A列に転記します。
    
    Next I

    For I = 2 To mRow  'シート「社員追加データ」の最終行まで繰り返します。
      TempCells = ""
      
      For Each MultiCells In Range(ws02.Cells(I, 1), ws02.Cells(I, 7)) '社員追加データのA列～G列のデータを結合します。
          TempCells = TempCells & MultiCells.Text & ""
      Next MultiCells
      
      ws03.Cells(I, "B").Value = TempCells   '結合したデータをシート「Work」A列に転記します。
    
    
    Next I
     
    
    L = lRow + 1  '追記行を求める（A列最終行＋１）

    For I = 2 To mRow  '追記対象データ分繰り返す（最終行まで）

        Set CheckCells = ws03.Range("A:A").Find(ws03.Cells(I, "B"))           'A列全てに対してD列の追記対象データを1件ずつ照合する。
    
        If CheckCells Is Nothing Then  'データが無ければ追記対象データをA列の最終行記します。
            ws01.Range("A" & L & ":G" & L).Value = ws02.Range("A" & I & ":G" & I).Value
            L = L + 1  'A列の追記行に＋１を加算する。
            
        End If
    Next I
        
        
End Sub
'