Сравнение двух спецификаций в Excel

[Vitalij Lysanov]

Программа сравнивает две спецификации на Лист1 и Лист2.
Текст может смешаться по высоте.

На первом листе находим текст в четвертой колонке, и ищем этот текст на втором листе.
Дальше осматриваем в строке.

Если тексты равны, закрашивается зеленым.
При копировании и вставке спецификаций в листы, программа должна нормально работать.
При проверке работы программы, и ручных изменениях, сравнение на равенство может не сработать, тут текстовые, числовые переменные, пробелы лишние могут быть, хотя на вид все нормально. Если на вид нормально, можно скопировать ячейки между листами. Графу количество можно перевести в числовые переменные и сравнивать, как числа. (при доработке программы, или вручную изменить формат колонок в листах)

Запуск программы, нажать на первом листе синий квадрат.
Макрос стоит на автозапуске при открытии файла, но пока не заметно?

Здесь тоже есть графическая запись макроса. Коды заливки и очистки получены графической записью.

Код Выделить Развернуть

Sub Auto_Open()
'
' Макрос1 Макрос Auto_Open
'

' Очистка заливки

Sheets("Лист1").Select
     Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Sheets("Лист2").Select
     Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
   
Sheets("Лист1").Select
   
   
   
   
   
   
' Запись в массивы

Dim list1(1000, 20)
Dim list2(1000, 20)
   
Sheets("Лист1").Select
For i = 1 To 1000
   For j = 1 To 20
     list1(i, j) = Cells(i, j)
   Next j
Next i


Sheets("Лист2").Select
For i = 1 To 1000
   For j = 1 To 20
     list2(i, j) = Cells(i, j)
   Next j
Next i


Sheets("Лист1").Select

' Осмотр 4 колонки первого листа

For i = 1 To 1000
   If Cells(i, 4) = "" Then GoTo 777
   
   
   tmp = list1(i, 4)
   
' Осмотр 4 колонки второго листа
   
   For j = 1 To 1000
       If tmp = list2(j, 4) Then GoTo 123
       GoTo 124
123


'__________________________________________

    For gor = 1 To 20
       
       
' Сравнение ячеек
       If list1(i, gor) = list2(j, gor) Then GoTo 555
       
       GoTo 556
555

'_____
       
         
' Заливка ячейки

         Cells(i, gor).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.599963377788629
        .PatternTintAndShade = 0
    End With
       
       
       '_____
556
       
       
   
   
    Next gor


'__________________________________________


124
   
   Next j

777
Next i

Cells(1, 1).Activate
Cells(1, 1).Select

End Sub