Sub CompareArrays()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Сравнение")

    Dim arr1 As Variant, arr2 As Variant
    Dim keyCol1 As Integer, keyCol2 As Integer
    Dim dict1 As Object, dict2 As Object
    Dim key As Variant
    Dim r As Long, c As Long
    Dim rowIndex As Variant

    ' Определяем массивы данных
    arr1 = ws.Range("A2:I300").Value ' Замените на диапазон вашей первой таблицы
    arr2 = ws.Range("J2:R300").Value ' Замените на диапазон вашей второй таблицы

    ' Определяем столбцы ключей (1 - это первый столбец в массиве)
    keyCol1 = 1
    keyCol2 = 1

    ' Создаем словари для хранения ключей и индексов
    Set dict1 = CreateObject("Scripting.Dictionary")
    Set dict2 = CreateObject("Scripting.Dictionary")

    ' Заполняем словари данными из массивов
    For r = 1 To UBound(arr1, 1)
        key = arr1(r, keyCol1) & arr1(r, keyCol1 + 1)
        dict1(key) = r
    Next r

    For r = 1 To UBound(arr2, 1)
        key = arr2(r, keyCol2) & arr2(r, keyCol2 + 1)
        dict2(key) = r
    Next r

    ' Сравниваем массивы и выделяем изменения
    For Each key In dict1.Keys
        If Not dict2.exists(key) Then
            ' Удаленные данные - синим цветом
            rowIndex = dict1(key)
            For c = 1 To UBound(arr1, 2)
                ws.Cells(rowIndex + 1, c).Interior.Color = RGB(0, 0, 255)
            Next c
        Else
            rowIndex = dict1(key)
            For c = 1 To UBound(arr1, 2)
                If arr1(rowIndex, c) <> arr2(dict2(key), c) Then
                    ' Измененные данные - красным цветом
                    ws.Cells(rowIndex + 1, c).Interior.Color = RGB(255, 0, 0)
                    ws.Cells(dict2(key) + 1, c + 9).Interior.Color = RGB(255, 0, 0)
                End If
            Next c
            ' Строка с изменениями - желтым цветом только первый столбец
            ws.Cells(rowIndex + 1, 1).Interior.ColorIndex = 6
            dict2.Remove key
        End If
    Next key

    ' Новые данные - зеленым цветом
    For Each key In dict2.Keys
        rowIndex = dict2(key)
        For c = 1 To UBound(arr2, 2)
            ws.Cells(rowIndex + 1, c + 9).Interior.Color = RGB(0, 255, 0)
        Next c
    Next key

    MsgBox "Сравнение завершено.", vbInformation
End Sub