Сравнить две таблицы на листе в Excel

Function ÑðàâíåíèåÒàáëèö(rng1 As Range, rng2 As Range)
boolResult = True
'öèêë ïåðåáîðà ñòðîê òàáëèöû
For CurrentRow = 1 To rng1.Rows.Count
    'ïðåîáðàçîâòü òåêóùóþ ñòðîêó â ìàññèâ
    arCurRow1 = fRangToArray(rng1.Range(Cells(CurrentRow, 1), Cells(CurrentRow, rng1.Columns.Count)))
    arCurRow2 = fRangToArray(rng2.Range(Cells(CurrentRow, 1), Cells(CurrentRow, rng1.Columns.Count)))
    'óïîðÿäî÷èòü ìàññèâû
    BubbleSort arCurRow1
    BubbleSort arCurRow2
    'ôëàã ðàâåíñòâà òàáëèö
    boolResult = boolResult And fCompareRows(arCurRow1, arCurRow2)
    'äëÿ îòëàäêè, âûâîäèò â Immediate ðàçëè÷àþùèåñÿ ñòðîêè, äëÿ àíàëèçà
    If Not boolResult Then
        For I = 0 To UBound(arCurRow1)
            S1 = S1 & arCurRow1(I) & "  "
            S2 = S2 & arCurRow2(I) & "  "
        Next I
        Debug.Print S1
        Debug.Print S2
        Debug.Print ""
        Exit For
    End If
 
Next CurrentRow
'âûâîä ðåçóëüòàòà
If boolResult Then
    Result = "ðàâíû"
Else
    Result = "íå ðàâíû, ñìîòðè 'Immediate widow'"
End If
ÑðàâíåíèåÒàáëèö = "Òàáëèöû " & Result
End Function
 
Public Function fRangToArray(Rng As Range)
Dim Arr() As String
ReDim Arr(Rng.Columns.Count - 1)
For I = 1 To Rng.Columns.Count
    Arr(I - 1) = Rng.Cells(1, I).Value
Next I
fRangToArray = Arr
End Function
 
Public Function fCompareRows(Arr1, Arr2)
For I = 0 To UBound(Arr1)
    If Not LCase(Arr1(I)) = LCase(Arr2(I)) Then
        fCompareRows = False
        Exit Function
    End If
Next I
fCompareRows = True
End Function
 
'Ïðîöåäóðà äëÿ ñîðòèðîâêè ìàññèâà ìåòîäîì ïóçûðüêà
Sub BubbleSort(ByRef Arr)
    Dim I
    Dim J
    Dim Tmp
 
    For I = 0 To UBound(Arr) Step 1
        For J = 0 To UBound(Arr) - 1 - I Step 1
            If LCase(Arr(J)) > LCase(Arr(J + 1)) Then
                Tmp = Arr(J)
                Arr(J) = Arr(J + 1)
                Arr(J + 1) = Tmp
            End If
        Next J
    Next I
End Sub

Private Sub btPoluchitj_Click()
Static r1 As Range
Static r2 As Range
Select Case btPoluchitj.Caption
    Case "добавить выделенное как таблицу 1"
        Set r1 = Selection
        btPoluchitj.Caption = "добавить выделенное как таблицу 2"
    Case "добавить выделенное как таблицу 2"
        Set r2 = Selection
        btPoluchitj.Enabled = False
        
        AddDataToSpreadShets r1, r2
        DtSort
End Select
End Sub
 
Private Sub btCompTable_Click()
Dim uRng1 As OWC10.Range
Dim uRng2 As OWC10.Range
Static m As Integer
Static s As String
 
s = IIf(m = 0, "НЕ найдены", s)
m = m + 1
Set uRng1 = Spreadsheet1.ActiveSheet.UsedRange
Set uRng2 = Spreadsheet2.ActiveSheet.UsedRange
If uRng1.Columns.Count = uRng1.Columns.Count And uRng1.Rows.Count = uRng1.Rows.Count Then
    For n = m To uRng1.Cells.Count
        If uRng1.Cells(n) <> uRng2.Cells(n) Then
            uRng1.Cells(n).Select
            uRng2.Cells(n).Select
            s = "найдены"
            MsgBox Chr(9) & "в этих ячейках данные различаются" & Chr(10) & _
            "снова нажмите кнопку 'сравнить таблицы' чтобы продолжить поиск отличий"
            Spreadsheet2.SetFocus
            m = IIf(m = uRng1.Cells.Count, 0, m)
            Exit For
        Else
            m = m + 1
        End If
        If n = uRng1.Cells.Count Then
            m = 0
            MsgBox "сравнение таблиц завершено, отличия " & s
        End If
    Next n
Else
        MsgBox "таблицы разного размера!"
End If
End Sub
 
 
Public Sub AddDataToSpreadShets(Rng1 As Range, Rng2 As Range)
Dim Rng As Range
Dim i As Integer
 
Rng1.Copy
Spreadsheet1.Range("A1").Paste
Spreadsheet1.Columns.AutoFit
 
 
 
Arr = Spreadsheet1.Worksheets(1).UsedRange.Range("A1", Chr(Asc("A") + Spreadsheet1.Worksheets(1).UsedRange.Columns.Count - 1) & 1)
 
For i = 1 To UBound(Arr, 2)
    Set Rng = Rng2.Range("A1", Rng2.Cells(1, Rng2.Columns.Count)).Find(Arr(1, i))
    If Not Rng Is Nothing Then
        CurCol = Rng.Column - Rng2.Column + 1  'поизиция текущего столбца в Rng2
        Rng2.Range(Cells(1, CurCol), Cells(Rng2.Rows.Count, CurCol)).Copy
        Spreadsheet2.Range(Chr(Asc("A") - 1 + i) & 1).Paste
    Else
        Rng2(1, CurCol + 1).Select
        Rng2.Worksheet.Activate
        a = MsgBox(Chr(9) & Chr(9) & "текст заголовка такой:" & Chr(10) & Chr(10) & Selection.Text& _
        , , "такого заголовка нет в таблице2" & "  (столбец " & i & ")")
        Exit Sub
    End If
Next i
UserForm1.Spreadsheet1.Range("A1").Select
UserForm1.Spreadsheet2.Range("A1").Select
End Sub
 
Public Sub DtSort()
Spreadsheet1.ActiveSheet.Range(Chr(Asc("A")) & 2, Chr(Asc("A") + Spreadsheet1.ActiveSheet.UsedRange.Columns.Count) & _
Spreadsheet1.ActiveSheet.UsedRange.Rows.Count).Select
Spreadsheet2.ActiveSheet.Range(Chr(Asc("A")) & 2, Chr(Asc("A") + Spreadsheet2.ActiveSheet.UsedRange.Columns.Count) & _
Spreadsheet2.ActiveSheet.UsedRange.Rows.Count).Select
 
For i = Spreadsheet1.ActiveSheet.UsedRange.Columns.Count To 1 Step -1
    Spreadsheet1.Selection.Sort i
    Spreadsheet2.Selection.Sort i
Next i
UserForm1.Spreadsheet1.Range("A1").Select
UserForm1.Spreadsheet2.Range("A1").Select
Spreadsheet2.Columns.AutoFit
 
End Sub
 
Private Sub UserForm_Click()
 
End Sub