Excelで重複確認をしたい。 シート2のA列からF列にあるデータと、シート3のA列からF列にあるデ

Excelで重複確認をしたい。
シート2のA列からF列にあるデータと、シート3のA列からF列にあるデータの重複確認をして残ったデータをシート1に反映する方法を教えてください。
大量にあるExcelデータで、重複していないデータを確認したいのですが、紙に打ち出して確認しています。これをどうにかしたいのですが。

質問者からの補足コメント

• 職場のRC環境がネットに繋がっていないためマクロを直接入力しましたが、今、次のところコンパイルエラー構文エラーになっています。
  myStr = myStr & myR(i, j) & "_"
  　　　　　　　Next j
  　　　　　　　　If Not
  の If Not のところです。

    補足日時：2019/02/07 07:48

No.1 回答者： tom04 回答日時： 2019/02/01 09:42

こんにちは！

A～F列データで重複した以内データで
Sheet2・Sheet3の各シートで他方のシートにないデータをSheet1に表示すれば良いのですね。

＞大量にあるExcelデータで・・・
というコトなので、VBAにしてみました。
尚、Sheet2・Sheet3とも1行目は項目行でデータは2行目以降にあるという前提です。

一例です。
標準モジュールにしてください。

Sub Sample1()
　Dim myDic1 As Object, myDic2 As Object
　Dim i As Long, j As Long, lastRow As Long
　Dim myStr As String, cnt As Long
　Dim myKey1, myKey2, myR, myAry
　　Set myDic1 = CreateObject("Scripting.Dictionary")
　　Set myDic2 = CreateObject("Scripting.Dictionary")
　　　With Worksheets("Sheet2")
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　myR = Range(.Cells(2, "A"), .Cells(lastRow, "F"))
　　　　　　For i = 1 To UBound(myR, 1)
　　　　　　　For j = 1 To 6
　　　　　　　　myStr = myStr & myR(i, j) & "_"
　　　　　　　Next j
　　　　　　　　If Not myDic1.exists(myStr) Then
　　　　　　　　　myDic1.Add myStr, ""
　　　　　　　　End If
　　　　　　　myStr = ""
　　　　　　Next i
　　　End With
　　　With Worksheets("Sheet3")
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　myR = Range(.Cells(2, "A"), .Cells(lastRow, "F"))
　　　　　　For i = 1 To UBound(myR, 1)
　　　　　　　For j = 1 To 6
　　　　　　　　myStr = myStr & myR(i, j) & "_"
　　　　　　　Next j
　　　　　　　　If Not myDic2.exists(myStr) Then
　　　　　　　　　myDic2.Add myStr, ""
　　　　　　　　End If
　　　　　　　myStr = ""
　　　　　　Next i
　　　End With
　　myKey1 = myDic1.keys
　　myKey2 = myDic2.keys
　　cnt = 1
　　　With Worksheets("Sheet1")
　　　　.Range("A:F").ClearContents
　　　　.Range("A1:F1").Value = Worksheets("Sheet2").Range("A1:F1").Value
　　　　　For i = 0 To UBound(myKey1)
　　　　　　If Not myDic2.exists(myKey1(i)) Then
　　　　　　　myAry = Split(myKey1(i), "_")
　　　　　　　cnt = cnt + 1
　　　　　　　　For j = 0 To UBound(myAry)
　　　　　　　　　.Cells(cnt, j + 1) = myAry(j)
　　　　　　　　Next j
　　　　　　End If
　　　　　Next i
　　　　　For i = 0 To UBound(myKey2)
　　　　　　If Not myDic1.exists(myKey2(i)) Then
　　　　　　　myAry = Split(myKey2(i), "_")
　　　　　　　cnt = cnt + 1
　　　　　　　　For j = 0 To UBound(myAry)
　　　　　　　　　.Cells(cnt, j + 1) = myAry(j)
　　　　　　　　Next j
　　　　　　End If
　　　　　Next i
　　　　.Activate
　　　End With
　　Set myDic1 = Nothing
　　Set myDic2 = Nothing
　　MsgBox "完了"
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

tom04様
ご回答頂きありがとうございました。
早速試してみます。

お礼日時：2019/02/01 12:37