Option Explicit
Public Sub 商品比較()
    Dim sh1 As Worksheet    'Sheet1
    Dim sh2 As Worksheet    'Sheet2
    Dim sh3 As Worksheet    '比較
    Dim dic1 As Object      'Sheet1の商品
    Dim dic2 As Object      'Sheet2の商品
    Dim maxrow1 As Long     'Sheet1の最大行
    Dim maxrow2 As Long     'Sheet2の最大行
    Dim row1 As Long        'Sheet1の行カウンター
    Dim row2 As Long        'Sheet2の行カウンター
    Dim row3 As Long: row3 = 2  '比較シートの行カウンター
    Dim key As Variant      'キー（商品）
    Set dic1 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set dic2 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("Sheet2")
    Set sh3 = Worksheets("比較")
    maxrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row 'sheet1 最終行を求める
    maxrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row 'sheet2 最終行を求める
    '比較シートの２行目以降をクリア
    sh3.Rows("2:" & Rows.Count).ClearContents
    With Sheets("sheet1").Range("a1").CurrentRegion.Offset(1, 0)
        .Resize(.Rows.Count - 1).Copy Sheets("比較").Range("a2")
    End With
    'Sheet2の商品をdic2へ登録
    For row2 = 2 To maxrow2
        key = sh2.Cells(row2, "A").Value
        dic2(key) = row2
    Next
    'Sheet1の商品がSheet2にあるかチェックする
    For row1 = 2 To maxrow1
        key = sh1.Cells(row1, "A").Value
        If dic2.exists(key) = True Then
            'Sheet1の商品がSheet2に存在する場合
            sh3.Cells(row3, "D").Resize(, 3).Value = sh1.Cells(row1, "A").Resize(, 3).Value
            row3 = row3 + 1
            dic2.Remove (key)   'dic2から該当キーを削除
        Else
            dic1(key) = row1
        End If
    Next
    row3 = row3 + 3
    'Sheet1にありSheet2にない商品を出力する
    For Each key In dic1.keys
        row1 = dic1(key)
        sh3.Cells(row3, "D").Resize(, 3).Value = sh1.Cells(row1, "A").Resize(, 3).Value
        row3 = row3 + 1
    Next
    'Sheet2にありSheet1にない商品を出力する
    For Each key In dic2.keys
        row2 = dic2(key)
        sh3.Cells(row3, "D").Resize(, 3).Value = sh2.Cells(row2, "A").Resize(, 3).Value
        row3 = row3 + 1
    Next
    MsgBox ("完了")
End Sub
 

T3B0aW9uIEV4cGxpY2l0ClB1YmxpYyBTdWIg5ZWG5ZOB5q+U6LyDKCkKICAgIERpbSBzaDEgQXMgV29ya3NoZWV0ICAgICdTaGVldDEKICAgIERpbSBzaDIgQXMgV29ya3NoZWV0ICAgICdTaGVldDIKICAgIERpbSBzaDMgQXMgV29ya3NoZWV0ICAgICfmr5TovIMKICAgIERpbSBkaWMxIEFzIE9iamVjdCAgICAgICdTaGVldDHjga7llYblk4EKICAgIERpbSBkaWMyIEFzIE9iamVjdCAgICAgICdTaGVldDLjga7llYblk4EKICAgIERpbSBtYXhyb3cxIEFzIExvbmcgICAgICdTaGVldDHjga7mnIDlpKfooYwKICAgIERpbSBtYXhyb3cyIEFzIExvbmcgICAgICdTaGVldDLjga7mnIDlpKfooYwKICAgIERpbSByb3cxIEFzIExvbmcgICAgICAgICdTaGVldDHjga7ooYzjgqvjgqbjg7Pjgr/jg7wKICAgIERpbSByb3cyIEFzIExvbmcgICAgICAgICdTaGVldDLjga7ooYzjgqvjgqbjg7Pjgr/jg7wKICAgIERpbSByb3czIEFzIExvbmc6IHJvdzMgPSAyICAn5q+U6LyD44K344O844OI44Gu6KGM44Kr44Km44Oz44K/44O8CiAgICBEaW0ga2V5IEFzIFZhcmlhbnQgICAgICAn44Kt44O877yI5ZWG5ZOB77yJCiAgICBTZXQgZGljMSA9IENyZWF0ZU9iamVjdCgiU2NyaXB0aW5nLkRpY3Rpb25hcnkiKSAnIOmAo+aDs+mFjeWIl+OBruWumue+qQogICAgU2V0IGRpYzIgPSBDcmVhdGVPYmplY3QoIlNjcmlwdGluZy5EaWN0aW9uYXJ5IikgJyDpgKPmg7PphY3liJfjga7lrprnvqkKICAgIFNldCBzaDEgPSBXb3Jrc2hlZXRzKCJTaGVldDEiKQogICAgU2V0IHNoMiA9IFdvcmtzaGVldHMoIlNoZWV0MiIpCiAgICBTZXQgc2gzID0gV29ya3NoZWV0cygi5q+U6LyDIikKICAgIG1heHJvdzEgPSBzaDEuQ2VsbHMoUm93cy5Db3VudCwgIkEiKS5FbmQoeGxVcCkuUm93ICdzaGVldDEg5pyA57WC6KGM44KS5rGC44KB44KLCiAgICBtYXhyb3cyID0gc2gyLkNlbGxzKFJvd3MuQ291bnQsICJBIikuRW5kKHhsVXApLlJvdyAnc2hlZXQyIOacgOe1guihjOOCkuaxguOCgeOCiwogICAgJ+avlOi8g+OCt+ODvOODiOOBru+8kuihjOebruS7pemZjeOCkuOCr+ODquOCogogICAgc2gzLlJvd3MoIjI6IiAmIFJvd3MuQ291bnQpLkNsZWFyQ29udGVudHMKICAgIFdpdGggU2hlZXRzKCJzaGVldDEiKS5SYW5nZSgiYTEiKS5DdXJyZW50UmVnaW9uLk9mZnNldCgxLCAwKQogICAgICAgIC5SZXNpemUoLlJvd3MuQ291bnQgLSAxKS5Db3B5IFNoZWV0cygi5q+U6LyDIikuUmFuZ2UoImEyIikKICAgIEVuZCBXaXRoCiAgICAnU2hlZXQy44Gu5ZWG5ZOB44KSZGljMuOBuOeZu+mMsgogICAgRm9yIHJvdzIgPSAyIFRvIG1heHJvdzIKICAgICAgICBrZXkgPSBzaDIuQ2VsbHMocm93MiwgIkEiKS5WYWx1ZQogICAgICAgIGRpYzIoa2V5KSA9IHJvdzIKICAgIE5leHQKICAgICdTaGVldDHjga7llYblk4HjgYxTaGVldDLjgavjgYLjgovjgYvjg4Hjgqfjg4Pjgq/jgZnjgosKICAgIEZvciByb3cxID0gMiBUbyBtYXhyb3cxCiAgICAgICAga2V5ID0gc2gxLkNlbGxzKHJvdzEsICJBIikuVmFsdWUKICAgICAgICBJZiBkaWMyLmV4aXN0cyhrZXkpID0gVHJ1ZSBUaGVuCiAgICAgICAgICAgICdTaGVldDHjga7llYblk4HjgYxTaGVldDLjgavlrZjlnKjjgZnjgovloLTlkIgKICAgICAgICAgICAgc2gzLkNlbGxzKHJvdzMsICJEIikuUmVzaXplKCwgMykuVmFsdWUgPSBzaDEuQ2VsbHMocm93MSwgIkEiKS5SZXNpemUoLCAzKS5WYWx1ZQogICAgICAgICAgICByb3czID0gcm93MyArIDEKICAgICAgICAgICAgZGljMi5SZW1vdmUgKGtleSkgICAnZGljMuOBi+OCieipsuW9k+OCreODvOOCkuWJiumZpAogICAgICAgIEVsc2UKICAgICAgICAgICAgZGljMShrZXkpID0gcm93MQogICAgICAgIEVuZCBJZgogICAgTmV4dAogICAgcm93MyA9IHJvdzMgKyAzCiAgICAnU2hlZXQx44Gr44GC44KKU2hlZXQy44Gr44Gq44GE5ZWG5ZOB44KS5Ye65Yqb44GZ44KLCiAgICBGb3IgRWFjaCBrZXkgSW4gZGljMS5rZXlzCiAgICAgICAgcm93MSA9IGRpYzEoa2V5KQogICAgICAgIHNoMy5DZWxscyhyb3czLCAiRCIpLlJlc2l6ZSgsIDMpLlZhbHVlID0gc2gxLkNlbGxzKHJvdzEsICJBIikuUmVzaXplKCwgMykuVmFsdWUKICAgICAgICByb3czID0gcm93MyArIDEKICAgIE5leHQKICAgICdTaGVldDLjgavjgYLjgopTaGVldDHjgavjgarjgYTllYblk4HjgpLlh7rlipvjgZnjgosKICAgIEZvciBFYWNoIGtleSBJbiBkaWMyLmtleXMKICAgICAgICByb3cyID0gZGljMihrZXkpCiAgICAgICAgc2gzLkNlbGxzKHJvdzMsICJEIikuUmVzaXplKCwgMykuVmFsdWUgPSBzaDIuQ2VsbHMocm93MiwgIkEiKS5SZXNpemUoLCAzKS5WYWx1ZQogICAgICAgIHJvdzMgPSByb3czICsgMQogICAgTmV4dAogICAgTXNnQm94ICgi5a6M5LqGIikKRW5kIFN1Ygo=