【エクセル・マクロ・VBA】相手シート記入（×を記入）／マッチング（アクティブシート・右隣のシート）／行

相手シートの最終列に-1を記入／マッチング（アクティブシート・右隣のシート）

このVBAコードは、2つのシート間でデータを比較し、データの重複をチェックしています。

＊ActiveSheetの右隣にあるシート(sheet_1)と、ActiveSheet自身のシート(sheet_2)のデータを比較し、sheet_2に存在するがsheet_1に存在しないデータをsheet_1に追加する処理を行っています。

Sub ディクショナリ_シート間処理()
Dim sheet_1 As Worksheet, sheet_2 As Worksheet
Set sheet_1 = ActiveSheet.Next
Set sheet_2 = ActiveSheet

Dim LastLow1 As Long, LastLow2 As Long, LastCol2 As Long, LastCol1 As Long
LastLow1 = sheet_1.Cells(Rows.Count, 1).End(xlUp).Row
LastCol1 = sheet_1.Cells(2, Columns.Count).End(xlToLeft).Column
LastLow2 = sheet_2.Cells(Rows.Count, 1).End(xlUp).Row
LastCol2 = sheet_2.Cells(2, Columns.Count).End(xlToLeft).Column

Dim myDic As Object, myKey
Dim c, myVal
Dim i As Long
Set myDic = CreateObject("Scripting.Dictionary")

'基シート（アクティブシート）
On Error Resume Next
For i = 2 To LastLow2
    'sheet_2.Cells(i, LastCol2).Value = "×"
         
    If Not myDic.Exists(sheet_2.Cells(i, 1).Value) Then
        myDic.Add (sheet_2.Cells(i, 1).Value), (sheet_2.Cells(i, LastCol2).Value)
    End If

Next i

'アクティブシートの右隣のシート
For i = 2 To LastLow1
    
    If Not myDic.Exists(sheet_1.Cells(i, 1).Value) Then
        sheet_1.Cells(i, LastCol1 + 1).Value = Not myDic.Item(sheet_2.Cells(i, LastCol2).Value)
    End If

Next i
    
On Error GoTo 0

Set myDic = Nothing
Set sheet_1 = Nothing
Set sheet_2 = Nothing

MsgBox "完了"
End Sub

解説

まず、sheet_1とsheet_2をSet文を使ってそれぞれ設定しています。その後、それぞれのシートの最終行と最終列を取得しています。これらは、データの範囲を把握するために必要です。

次に、Scripting.Dictionaryオブジェクトを作成し、myDicに代入しています。このオブジェクトは、キーと値のペアを管理するために使用されます。

以下のForループでは、まずsheet_2に存在するデータをmyDicに追加しています。myDicには、1列目の値をキーとして、最終列の値を値として格納しています。

次に、sheet_1に存在するかどうかをmyDicを使ってチェックし、存在しない場合には、sheet_1の最終列の右隣にある列にNot myDic.Item(sheet_2.Cells(i, LastCol2).Value)を設定しています。ここで、myDic.Itemメソッドは、指定されたキーに対応する値を返します。Not演算子は、TrueとFalseを反転させるために使われます。

最後に、メッセージボックスを表示して、処理が完了したことを通知しています。