【エクセルVBA】シート同士の行を比較するマクロ(複数列の対応可)

    Dim RowNum1 As Long
    Dim RowNum2 As Long
    Dim ColumnNum1 As Long
    Dim ColumnNum2 As Long
    Dim sht1 As Worksheet: Set sht1 = ThisWorkbook.Sheets("比較1")
    Dim sht2 As Worksheet: Set sht2 = ThisWorkbook.Sheets("比較2")
　　'今回は比較するための二つのシート名を「比較1」、「比較２」としました。
    
    '//比較1,2シートの行数を取得する(フィルター後)。
    RowNum1 = sht1.UsedRange.Columns(1).SpecialCells(xlCellTypeVisible).Count
    RowNum2 = sht2.UsedRange.Columns(1).SpecialCells(xlCellTypeVisible).Count   

    '//比較1,2シートの列数を取得する。
    ColumnNum1 = WorksheetFunction.Subtotal(3, sht1.Range("A1").CurrentRegion.Rows(1))
    ColumnNum2 = WorksheetFunction.Subtotal(3, sht2.Range("A1").CurrentRegion.Rows(1))

    Dim ar1() As String     '比較1シートの要素格納用の配列
    Dim ar2() As String     '比較2シートの要素格納用の配列

    '//シートの行数に応じて、配列のサイズを決定する。
    '二次元目の大きさは、要素を格納しているシートの列数 + flag分
    ReDim ar1(RowNum1 - 1, ColumnNum1 + 1)
    ReDim ar2(RowNum2 - 1, ColumnNum2 + 1)

Function House_RowNum(sht As Worksheet, RowNum As Long) As String()
Dim ar1() As String
ReDim ar1(RowNum - 1)
    '//配列ar1(〇、0)：行番号を格納
    '//(オートフィルター後の行番号を格納する。)
        r = 2
        i = 0
        Do While sht.Cells(r, 2) <> ""     'フィルターをかけているB列の値の有無で最終行を判別。Ｂ列が空の行になるまでループを回し続ける。
          If sht.Cells(r, 2).EntireRow.Hidden = False Then
             ar1(i) = r
             i = i + 1
          End If
          r = r + 1
        Loop
    '//配列ar1(〇、0)：行番号を格納完了
    House_RowNum = ar1
End Function

    Dim ar3() As String     '比較1シートの行番号格納用の配列
    Dim ar4() As String     '比較2シートの行番号格納用の配列
    '行番号の格納
    ar3() = House_RowNum(sht1, RowNum1)
    ar4() = House_RowNum(sht2, RowNum2)
    '行番号の格納完了
    
    '格納した行番号を二次元配列へ格納し直す。
    For i = 0 To UBound(ar3)
        ar1(i, 0) = ar3(i)
    Next i
    
    For i = 0 To UBound(ar4)
        ar2(i, 0) = ar4(i)
    Next i
    '格納した行番号を二次元配列へ格納し直す(完了)。

    '//配列ar1へセルの要素を格納
    With sht1
        For i = 0 To UBound(ar1) - 1　
            k = 1
            For j = 1 To ColumnNum1
                ar1(i, k) = .Cells(ar1(i, 0), j)　'ar1(i,0)はフィルター後の行番号が入っている配列
                k = k + 1
            Next j
                ar1(i, ColumnNum1 + 1) = 1　’Flagの値に1を入れています。
        Next i
    End With
    '//配列ar1へセルの要素を格納(完了)    

    '2つの配列が完全一致するかどうかをチェックする。
    'あれば最終列のFlag値を1にする。
    For l = 0 To UBound(ar1, 1)
        For j = LBound(ar2, 1) To UBound(ar2, 1) - 1
            k = 0
            For i = LBound(ar2, 2) + 1 To UBound(ar2, 2) - 1
                If ar1(l, i) = ar2(j, i) Then
                    k = k + 1       '調べた列数とkが一致すれば、2つの配列は完全一致している。
                End If
            Next i
            
            If k = UBound(ar2, 2) - 1 - LBound(ar2, 2) Then
'                MsgBox ("ar1とar2は完全一致しました。")
                ar1(l, UBound(ar1, 2)) = 0
                ar2(j, UBound(ar2, 2)) = 0
            End If
        Next j
    Next l
    '//ar1の各行(j)について、同じ要素のものがar2にないかチェック(完了)

    With sht1
        For j = 0 To UBound(ar1) - 1
            If ar1(j, UBound(ar1, 2)) = 1 Then
                .Range(.Cells(ar1(j, 0), 1), .Cells(ar1(j, 0), ColumnNum1)).Interior.Color = RGB(30, 144, 255)
            Else
                .Range(.Cells(ar1(j, 0), 1), .Cells(ar1(j, 0), ColumnNum1)).Interior.Color = RGB(255, 0, 0)
            End If
        Next j
    End With

    With sht2
        For j = 0 To UBound(ar2) - 1
                If ar2(j, UBound(ar2, 2)) = 1 Then
                    .Range(.Cells(ar2(j, 0), 1), .Cells(ar2(j, 0), ColumnNum1)).Interior.Color = RGB(30, 144, 255)
                Else
                    .Range(.Cells(ar2(j, 0), 1), .Cells(ar2(j, 0), ColumnNum1)).Interior.Color = RGB(255, 0, 0)
                End If
        Next j
    End With