Option Explicit

Sub シート比較自動試験()
    Const refSHname = "refSH"   '比較対象シート名
    If ActiveSheet.Name = refSHname Then msgEnd ("他のシートを選択して実行してください。")
    
    'refSHnameシートがあるか判定
    Dim sh As Long, rWS As Worksheet, tWS As Worksheet
    For sh = 1 To Worksheets.Count
        If Worksheets(sh).Name = refSHname Then
            Set rWS = Worksheets(sh)
            Set tWS = ActiveSheet
        End If
    Next sh
    
    '２シート選択されてるか判定
    If ActiveWindow.SelectedSheets.Count = 2 Then
        Set rWS = ActiveWindow.SelectedSheets(1)    '比較対象
        Set tWS = ActiveWindow.SelectedSheets(2)    'test対象
    ElseIf rWS Is Nothing Then
        msgEnd ("２シート選択するか比較対象シート名を「 " & refSHname & " 」に変更してください。")
    End If
    
    'UsedRange比較と値の比較をして、結果を出力メッセージ用変数に格納
    Dim uRangeDiff As Boolean, r As Variant, rValue As String, cnt As Long, rMsg As String
    If tWS.UsedRange.Address <> rWS.UsedRange.Address Then
        uRangeDiff = True
        rMsg = "UsedRangeが異なります。" & Chr(10)
        rMsg = rMsg & Chr(10)
        rMsg = rMsg & tWS.Name & " 　 " & rWS.Name & Chr(10)
        rMsg = rMsg & "[" & Replace(tWS.UsedRange.Address & "] ⇔ [" & rWS.UsedRange.Address, "$", "") & "]"
    Else
        For Each r In tWS.UsedRange
            If tWS.range(r.Address).Value <> rWS.range(r.Address).Value Then
                cnt = cnt + 1
                rMsg = rMsg & Chr(10) & Replace(r.Address, "$", "") & "   [" & tWS.range(r.Address) & "] ⇔ [" & rWS.range(r.Address) & "]"
            End If
        Next r
    End If
    
    '結果表示
    If uRangeDiff = True Then
        MsgBox rMsg, vbOKOnly, "範囲エラー"
    ElseIf cnt > 0 Then
        If cnt > 10 Then
            MsgBox cnt & "箇所違います", vbOKOnly, "値エラー"
        Else
            MsgBox (cnt & "箇所違います" & Chr(10) & Chr(10) & "Range " & tWS.Name & " 　 " & rWS.Name & rMsg), vbOKOnly, "値エラー"
        End If
    Else
        MsgBox rWS.Name & "と" & tWS.Name & "に相違点はありません"
    End If
End Sub

Private Sub msgEnd(msg)
    'メッセージを出して処理終了
    MsgBox msg
    End 'exit subじゃない
End Sub