Sub u_700()
    Application.ScreenUpdating = False
    a = Application.Match("ИТОГО", Range("b:b"), 0) - 1
    For b = 5 To a 'с 5-ой до строки, где ИТОГО (не включая)
        c = Application.Match(Range("b" & b), Sheets("S2").Range("b:b"), 0) '=ПОИСКПОЗ(
        d = Application.IsNumber(c) '=ЕЧИСЛО
        If d Then
            For e = 3 To 34 'с 3-го до 34 столбца
                f = Cells(b, e).Offset(0, -1).Interior.Color
                If Cells(b, e) <> Sheets("S2").Cells(c, e) Then
                    Cells(b, e).Interior.Color = 15652797
                    If f = 16777215 Then Range(Cells(b, 1), Cells(b, e - 1)).Interior.Color = 11389944
                Else
                    If f <> 16777215 Then Cells(b, e).Interior.Color = 11389944
                End If
            Next
        Else
            Range("a" & b & ":ah" & b).Interior.Color = 15652797
        End If
    Next
    Application.ScreenUpdating = False
End Sub

Sub CompareT2()

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

Dim table1 As Range, table2 As Range
Dim keyCol1 As Integer, keyCol2 As Integer
Dim lr1 As Long, lr2 As Long
Dim dict1 As Object, dict2 As Object
Dim cell As Range, key As Variant
Dim r As Long, c As Long
Dim rowIndex As Variant

' Определяем диапазоны таблиц
Set table1 = ws.Range("A1:I300") ' Замените на диапазон вашей первой таблицы
Set table2 = ws.Range("J1:R300") ' Замените на диапазон вашей второй таблицы
table1.Interior.ColorIndex = xlNone
table2.Interior.ColorIndex = xlNone

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

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

' Заполняем словари данными из таблиц
lr1 = table1.Rows.Count
lr2 = table2.Rows.Count

For r = 2 To lr1 ' Начинаем с 2, предполагая, что первая строка - заголовки
key = table1.Cells(r, keyCol1).Value2 & table1.Cells(r, keyCol1 + 1).Value2
dict1(key) = r
Next r

For r = 2 To lr2
key = table2.Cells(r, keyCol2).Value2 & table2.Cells(r, keyCol2 + 1).Value2
dict2(key) = r
Next r

' Сравниваем таблицы и выделяем изменения
For Each key In dict1.Keys
If Not dict2.exists(key) Then
' Удаленные данные - синим цветом
rowIndex = dict1(key)
For c = 1 To table1.Columns.Count
table1.Cells(rowIndex, c).Interior.Color = RGB(0, 0, 255)
Next c
Else
rowIndex = dict1(key)
For c = 1 To table1.Columns.Count
If table1.Cells(rowIndex, c).Value2 <> table2.Cells(dict2(key), c).Value2 Then
' Измененные данные - красным цветом
table1.Cells(rowIndex, c).Interior.Color = RGB(255, 0, 0)
table2.Cells(dict2(key), c).Interior.Color = RGB(255, 0, 0)
End If
Next c
' Строка с изменениями - желтым цветом
ws.Rows(rowIndex).Interior.ColorIndex = 6
dict2.Remove key
End If
Next key

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

' Highlight new data in table2
For Each key In dict2.Keys
rowIndex = dict2(key)
ws.Rows(rowIndex).Interior.ColorIndex = 4
Next key

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

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