Option Explicit
Public Sub シート比較()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim maxrow1 As Long
    Dim maxrow2 As Long
    Dim row1 As Long
    Dim row2 As Long
    Dim row3 As Long
    Dim dicT1 As Object
    Dim dicT2 As Object
    Dim key As Variant
    Dim reason As String
    Set ws1 = Worksheets("得意先")
    Set ws2 = Worksheets("自社")
    Set ws3 = Worksheets("相違")
    maxrow1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row  '最終行取得
    maxrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row  '最終行取得
    Set dicT1 = CreateObject("Scripting.Dictionary")
    Set dicT2 = CreateObject("Scripting.Dictionary")
    If maxrow1 < 2 Then
        MsgBox (ws1.Name & "にデータなし")
        Exit Sub
    End If
    If maxrow2 < 2 Then
        MsgBox (ws2.Name & "にデータなし")
        Exit Sub
    End If
    '得意先読込、異常時終了する
    If Read_Sheet(ws1, dicT1, maxrow1) = False Then Exit Sub
    '自社先読込、異常時終了する
    If Read_Sheet(ws2, dicT2, maxrow2) = False Then Exit Sub
    '相違の3行目以降をクリア
    ws3.Rows("3:" & Rows.Count).ClearContents
    row3 = 3
    '得意先の注文番号を順に全て処理する
    For Each key In dicT1.keys
        row1 = dicT1(key)
        row2 = 0
        reason = ""
        If dicT2.Exists(key) = False Then
            '自社に注文番号がない場合
            reason = "Ｂ注番なし"
        Else
            row2 = dicT2(key)
            If ws1.Cells(row1, "E").Value = ws2.Cells(row2, "E").Value Then
                If ws1.Cells(row1, "D").Value <> ws2.Cells(row2, "D").Value Then
                    '単価が等しく、個数が異なる場合
                    reason = "個数違い"
                End If
            Else
                '単価が異なる場合
                reason = "単価違い"
            End If
        End If
        If reason <> "" Then
            '相違が発生した場合
            'Ａシートの1行を転記、相違理由を設定
            ws3.Cells(row3, "A").Resize(1, 6) = ws1.Cells(row1, "A").Resize(1, 6).Value
            ws3.Cells(row3, "G").Value = reason
            If row2 <> 0 Then
                '単価違い又は個数違いの場合、Ｂシートの１行を転記、相違理由を設定
                ws3.Cells(row3, "J").Resize(1, 6) = ws2.Cells(row2, "A").Resize(1, 6).Value
                ws3.Cells(row3, "P").Value = reason
            End If
            row3 = row3 + 1
        End If
    Next
    '自社の注文番号を順に全て処理する
    For Each key In dicT2.keys
        row2 = dicT2(key)
        If dicT1.Exists(key) = False Then
            '得意先に注文番号がない場合、Ｂシートの１行を転記、相違理由を設定
            ws3.Cells(row3, "J").Resize(1, 6) = ws2.Cells(row2, "A").Resize(1, 6).Value
            ws3.Cells(row3, "P").Value = "Ａ注番なし"
            row3 = row3 + 1
        End If
    Next
    MsgBox ("完了 相違件数=" & row3 - 3)
End Sub
 
 
Private Function Read_Sheet(ByRef ws As Worksheet, ByRef dicT As Object, ByVal maxrow As Long) As Boolean
    Dim wrow As Long
    Dim key As Variant
    Read_Sheet = False
    '２行目～最終行まで処理
    For wrow = 2 To maxrow
        key = ws.Cells(wrow, "C").Value
        If key = "" Then
            Call err_msg(ws, wrow, "C", "注文番号が空白です")
            Exit Function
        End If
        If ws.Cells(wrow, "D").Value = "" Then
            Call err_msg(ws, wrow, "D", "個数が空白です")
            Exit Function
        End If
        If ws.Cells(wrow, "E").Value = "" Then
            Call err_msg(ws, wrow, "E", "単価が空白です")
            Exit Function
        End If
        If dicT.Exists(key) = True Then
            Call err_msg(ws, wrow, "C", "注文番号が重複しています")
            Exit Function
        End If
        '辞書へ注文番号と行番号を登録
        dicT(key) = wrow
    Next
    Read_Sheet = True
End Function
Private Sub err_msg(ByRef ws As Worksheet, ByVal row_no As Long, ByVal col_no As String, ByVal errmsg As String)
    MsgBox ("シート=" & ws.Name & " 行番号=" & row_no & " " & errmsg)
    ws.Activate
    ws.Cells(row_no, col_no).Select
End Sub
 
 

T3B0aW9uIEV4cGxpY2l0ClB1YmxpYyBTdWIg44K344O844OI5q+U6LyDKCkKICAgIERpbSB3czEgQXMgV29ya3NoZWV0CiAgICBEaW0gd3MyIEFzIFdvcmtzaGVldAogICAgRGltIHdzMyBBcyBXb3Jrc2hlZXQKICAgIERpbSBtYXhyb3cxIEFzIExvbmcKICAgIERpbSBtYXhyb3cyIEFzIExvbmcKICAgIERpbSByb3cxIEFzIExvbmcKICAgIERpbSByb3cyIEFzIExvbmcKICAgIERpbSByb3czIEFzIExvbmcKICAgIERpbSBkaWNUMSBBcyBPYmplY3QKICAgIERpbSBkaWNUMiBBcyBPYmplY3QKICAgIERpbSBrZXkgQXMgVmFyaWFudAogICAgRGltIHJlYXNvbiBBcyBTdHJpbmcKICAgIFNldCB3czEgPSBXb3Jrc2hlZXRzKCLlvpfmhI/lhYgiKQogICAgU2V0IHdzMiA9IFdvcmtzaGVldHMoIuiHquekviIpCiAgICBTZXQgd3MzID0gV29ya3NoZWV0cygi55u46YGVIikKICAgIG1heHJvdzEgPSB3czEuQ2VsbHMoUm93cy5Db3VudCwgIkEiKS5FbmQoeGxVcCkuUm93ICAn5pyA57WC6KGM5Y+W5b6XCiAgICBtYXhyb3cyID0gd3MyLkNlbGxzKFJvd3MuQ291bnQsICJBIikuRW5kKHhsVXApLlJvdyAgJ+acgOe1guihjOWPluW+lwogICAgU2V0IGRpY1QxID0gQ3JlYXRlT2JqZWN0KCJTY3JpcHRpbmcuRGljdGlvbmFyeSIpCiAgICBTZXQgZGljVDIgPSBDcmVhdGVPYmplY3QoIlNjcmlwdGluZy5EaWN0aW9uYXJ5IikKICAgIElmIG1heHJvdzEgPCAyIFRoZW4KICAgICAgICBNc2dCb3ggKHdzMS5OYW1lICYgIuOBq+ODh+ODvOOCv+OBquOBlyIpCiAgICAgICAgRXhpdCBTdWIKICAgIEVuZCBJZgogICAgSWYgbWF4cm93MiA8IDIgVGhlbgogICAgICAgIE1zZ0JveCAod3MyLk5hbWUgJiAi44Gr44OH44O844K/44Gq44GXIikKICAgICAgICBFeGl0IFN1YgogICAgRW5kIElmCiAgICAn5b6X5oSP5YWI6Kqt6L6844CB55Ww5bi45pmC57WC5LqG44GZ44KLCiAgICBJZiBSZWFkX1NoZWV0KHdzMSwgZGljVDEsIG1heHJvdzEpID0gRmFsc2UgVGhlbiBFeGl0IFN1YgogICAgJ+iHquekvuWFiOiqrei+vOOAgeeVsOW4uOaZgue1guS6huOBmeOCiwogICAgSWYgUmVhZF9TaGVldCh3czIsIGRpY1QyLCBtYXhyb3cyKSA9IEZhbHNlIFRoZW4gRXhpdCBTdWIKICAgICfnm7jpgZXjga4z6KGM55uu5Lul6ZmN44KS44Kv44Oq44KiCiAgICB3czMuUm93cygiMzoiICYgUm93cy5Db3VudCkuQ2xlYXJDb250ZW50cwogICAgcm93MyA9IDMKICAgICflvpfmhI/lhYjjga7ms6jmlofnlarlj7fjgpLpoIbjgavlhajjgablh6bnkIbjgZnjgosKICAgIEZvciBFYWNoIGtleSBJbiBkaWNUMS5rZXlzCiAgICAgICAgcm93MSA9IGRpY1QxKGtleSkKICAgICAgICByb3cyID0gMAogICAgICAgIHJlYXNvbiA9ICIiCiAgICAgICAgSWYgZGljVDIuRXhpc3RzKGtleSkgPSBGYWxzZSBUaGVuCiAgICAgICAgICAgICfoh6rnpL7jgavms6jmlofnlarlj7fjgYzjgarjgYTloLTlkIgKICAgICAgICAgICAgcmVhc29uID0gIu+8ouazqOeVquOBquOBlyIKICAgICAgICBFbHNlCiAgICAgICAgICAgIHJvdzIgPSBkaWNUMihrZXkpCiAgICAgICAgICAgIElmIHdzMS5DZWxscyhyb3cxLCAiRSIpLlZhbHVlID0gd3MyLkNlbGxzKHJvdzIsICJFIikuVmFsdWUgVGhlbgogICAgICAgICAgICAgICAgSWYgd3MxLkNlbGxzKHJvdzEsICJEIikuVmFsdWUgPD4gd3MyLkNlbGxzKHJvdzIsICJEIikuVmFsdWUgVGhlbgogICAgICAgICAgICAgICAgICAgICfljZjkvqHjgYznrYnjgZfjgY/jgIHlgIvmlbDjgYznlbDjgarjgovloLTlkIgKICAgICAgICAgICAgICAgICAgICByZWFzb24gPSAi5YCL5pWw6YGV44GEIgogICAgICAgICAgICAgICAgRW5kIElmCiAgICAgICAgICAgIEVsc2UKICAgICAgICAgICAgICAgICfljZjkvqHjgYznlbDjgarjgovloLTlkIgKICAgICAgICAgICAgICAgIHJlYXNvbiA9ICLljZjkvqHpgZXjgYQiCiAgICAgICAgICAgIEVuZCBJZgogICAgICAgIEVuZCBJZgogICAgICAgIElmIHJlYXNvbiA8PiAiIiBUaGVuCiAgICAgICAgICAgICfnm7jpgZXjgYznmbrnlJ/jgZfjgZ/loLTlkIgKICAgICAgICAgICAgJ++8oeOCt+ODvOODiOOBrjHooYzjgpLou6LoqJjjgIHnm7jpgZXnkIbnlLHjgpLoqK3lrpoKICAgICAgICAgICAgd3MzLkNlbGxzKHJvdzMsICJBIikuUmVzaXplKDEsIDYpID0gd3MxLkNlbGxzKHJvdzEsICJBIikuUmVzaXplKDEsIDYpLlZhbHVlCiAgICAgICAgICAgIHdzMy5DZWxscyhyb3czLCAiRyIpLlZhbHVlID0gcmVhc29uCiAgICAgICAgICAgIElmIHJvdzIgPD4gMCBUaGVuCiAgICAgICAgICAgICAgICAn5Y2Y5L6h6YGV44GE5Y+I44Gv5YCL5pWw6YGV44GE44Gu5aC05ZCI44CB77yi44K344O844OI44Gu77yR6KGM44KS6Lui6KiY44CB55u46YGV55CG55Sx44KS6Kit5a6aCiAgICAgICAgICAgICAgICB3czMuQ2VsbHMocm93MywgIkoiKS5SZXNpemUoMSwgNikgPSB3czIuQ2VsbHMocm93MiwgIkEiKS5SZXNpemUoMSwgNikuVmFsdWUKICAgICAgICAgICAgICAgIHdzMy5DZWxscyhyb3czLCAiUCIpLlZhbHVlID0gcmVhc29uCiAgICAgICAgICAgIEVuZCBJZgogICAgICAgICAgICByb3czID0gcm93MyArIDEKICAgICAgICBFbmQgSWYKICAgIE5leHQKICAgICfoh6rnpL7jga7ms6jmlofnlarlj7fjgpLpoIbjgavlhajjgablh6bnkIbjgZnjgosKICAgIEZvciBFYWNoIGtleSBJbiBkaWNUMi5rZXlzCiAgICAgICAgcm93MiA9IGRpY1QyKGtleSkKICAgICAgICBJZiBkaWNUMS5FeGlzdHMoa2V5KSA9IEZhbHNlIFRoZW4KICAgICAgICAgICAgJ+W+l+aEj+WFiOOBq+azqOaWh+eVquWPt+OBjOOBquOBhOWgtOWQiOOAge+8ouOCt+ODvOODiOOBru+8keihjOOCkui7ouiomOOAgeebuOmBleeQhueUseOCkuioreWumgogICAgICAgICAgICB3czMuQ2VsbHMocm93MywgIkoiKS5SZXNpemUoMSwgNikgPSB3czIuQ2VsbHMocm93MiwgIkEiKS5SZXNpemUoMSwgNikuVmFsdWUKICAgICAgICAgICAgd3MzLkNlbGxzKHJvdzMsICJQIikuVmFsdWUgPSAi77yh5rOo55Wq44Gq44GXIgogICAgICAgICAgICByb3czID0gcm93MyArIDEKICAgICAgICBFbmQgSWYKICAgIE5leHQKICAgIE1zZ0JveCAoIuWujOS6hiDnm7jpgZXku7bmlbA9IiAmIHJvdzMgLSAzKQpFbmQgU3ViCgoKUHJpdmF0ZSBGdW5jdGlvbiBSZWFkX1NoZWV0KEJ5UmVmIHdzIEFzIFdvcmtzaGVldCwgQnlSZWYgZGljVCBBcyBPYmplY3QsIEJ5VmFsIG1heHJvdyBBcyBMb25nKSBBcyBCb29sZWFuCiAgICBEaW0gd3JvdyBBcyBMb25nCiAgICBEaW0ga2V5IEFzIFZhcmlhbnQKICAgIFJlYWRfU2hlZXQgPSBGYWxzZQogICAgJ++8kuihjOebru+9nuacgOe1guihjOOBvuOBp+WHpueQhgogICAgRm9yIHdyb3cgPSAyIFRvIG1heHJvdwogICAgICAgIGtleSA9IHdzLkNlbGxzKHdyb3csICJDIikuVmFsdWUKICAgICAgICBJZiBrZXkgPSAiIiBUaGVuCiAgICAgICAgICAgIENhbGwgZXJyX21zZyh3cywgd3JvdywgIkMiLCAi5rOo5paH55Wq5Y+344GM56m655m944Gn44GZIikKICAgICAgICAgICAgRXhpdCBGdW5jdGlvbgogICAgICAgIEVuZCBJZgogICAgICAgIElmIHdzLkNlbGxzKHdyb3csICJEIikuVmFsdWUgPSAiIiBUaGVuCiAgICAgICAgICAgIENhbGwgZXJyX21zZyh3cywgd3JvdywgIkQiLCAi5YCL5pWw44GM56m655m944Gn44GZIikKICAgICAgICAgICAgRXhpdCBGdW5jdGlvbgogICAgICAgIEVuZCBJZgogICAgICAgIElmIHdzLkNlbGxzKHdyb3csICJFIikuVmFsdWUgPSAiIiBUaGVuCiAgICAgICAgICAgIENhbGwgZXJyX21zZyh3cywgd3JvdywgIkUiLCAi5Y2Y5L6h44GM56m655m944Gn44GZIikKICAgICAgICAgICAgRXhpdCBGdW5jdGlvbgogICAgICAgIEVuZCBJZgogICAgICAgIElmIGRpY1QuRXhpc3RzKGtleSkgPSBUcnVlIFRoZW4KICAgICAgICAgICAgQ2FsbCBlcnJfbXNnKHdzLCB3cm93LCAiQyIsICLms6jmlofnlarlj7fjgYzph43opIfjgZfjgabjgYTjgb7jgZkiKQogICAgICAgICAgICBFeGl0IEZ1bmN0aW9uCiAgICAgICAgRW5kIElmCiAgICAgICAgJ+i+nuabuOOBuOazqOaWh+eVquWPt+OBqOihjOeVquWPt+OCkueZu+mMsgogICAgICAgIGRpY1Qoa2V5KSA9IHdyb3cKICAgIE5leHQKICAgIFJlYWRfU2hlZXQgPSBUcnVlCkVuZCBGdW5jdGlvbgpQcml2YXRlIFN1YiBlcnJfbXNnKEJ5UmVmIHdzIEFzIFdvcmtzaGVldCwgQnlWYWwgcm93X25vIEFzIExvbmcsIEJ5VmFsIGNvbF9ubyBBcyBTdHJpbmcsIEJ5VmFsIGVycm1zZyBBcyBTdHJpbmcpCiAgICBNc2dCb3ggKCLjgrfjg7zjg4g9IiAmIHdzLk5hbWUgJiAiIOihjOeVquWPtz0iICYgcm93X25vICYgIiAiICYgZXJybXNnKQogICAgd3MuQWN0aXZhdGUKICAgIHdzLkNlbGxzKHJvd19ubywgY29sX25vKS5TZWxlY3QKRW5kIFN1YgoK