Sub HighlightDuplicates()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws3 As Worksheet
    Dim cell As Range
    Dim searchRange As Range
    Dim value As String
    
    ' Открытие файлов
    Set wb1 = Workbooks.Open("C:\Users\user\Desktop\Script\1.xlsx")
    Set wb2 = ThisWorkbook
    
    ' Выбор листов
    Set ws1 = wb1.Sheets("Сводный")
    Set ws3 = wb2.Sheets("Лист3")
    
    ' Очистка предыдущих заливок
    ws1.Cells.Interior.ColorIndex = xlNone
    ws3.Cells.Interior.ColorIndex = xlNone
    
    
    ' Применение фильтрации по двум столбцам
    ws1.Range("B:B").AutoFilter Field:=1, Criteria1:="Московское ЛПУМГ"
    ws1.Range("E:E").AutoFilter Field:=1, Criteria1:="Сужающее устройство", Operator:=xlAnd

    
    ' Перебор значений в столбце A листа 3
    For Each cell In ws3.Range("A1:A" & ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row)
        value = CStr(cell.value)
        
        ' Поиск значения в отфильтрованном столбце G листа 1
        On Error Resume Next
        Set searchRange = ws1.Range("G:G").SpecialCells(xlCellTypeVisible).Find(What:=value, LookIn:=xlValues, LookAt:=xlWhole)
        On Error GoTo 0
        
        If Not searchRange Is Nothing Then
            ' Если значение найдено, выделяем его желтым
            searchRange.Interior.Color = RGB(255, 255, 0)
            cell.Interior.Color = RGB(255, 255, 0)
        Else
            ' Если значение не найдено, выделяем его красным
            cell.Interior.Color = RGB(255, 0, 0)
        End If
    Next cell
    
    ' Отмена фильтров
    'ws1.AutoFilterMode = False
    
    ' Сохранение изменений и закрытие файла 1.xlsx
    'wb1.Close SaveChanges:=True
End Sub