Sub Prover()
    Application.ScreenUpdating = 0 'откл обновление экрана
    Application.Calculation = 3 'откл автопересчет формул
    n1_ = Cells(Rows.Count, "A").End(3).Row - 1 'кол-во строк на этом листе (Лист1), начиная со второй
    ar1 = Cells(2, 1).Resize(n1_).Value 'суем столбец А в массив
    ReDim ar2(1 To n1_, 1 To 1) 'создаем пустой массив
    Cells(2, 1).Resize(n1_).Interior.Color = 10092441 'красим все в зеленый
    With Sheets("База") 'для листа База
        n11_ = .Cells(.Rows.Count, "A").End(3).Row - 1 'кол-во строк, начиная со второй
        ar11 = .Cells(2, 1).Resize(n11_, 2).Value 'суем столбцы А:В в массив
    End With '
    Set slov = CreateObject("Scripting.Dictionary") 'объявляем словарь
    With slov 'для словаря
        .CompareMode = 1 'текстовое сравнение (бол и мал буквы не различаются)
        For i = 1 To UBound(ar11) 'цикл по массиву ar11
            .Item(Replace(ar11(i, 1), " ", "")) = ar11(i, 2) 'первый столбец (без пробелов) - ключ, второй - элемент словаря
        Next i
        For i = 1 To UBound(ar1) 'цикл по массиву ar1
            z_ = Replace(ar1(i, 1), " ", "") 'убираем пробелы
            If .Exists(z_) Then 'если полученное есть в словаре
                ar2(i, 1) = .Item(z_) 'в массив ar2 суем элемент для искомого ключа
            Else 'если нет в словаре
                Cells(i + 1, 1).Interior.Color = 5263615 'красим красным
            End If '
        Next i '
    End With '
    Cells(2, 2).Resize(n1_) = ar2 'в столбец 2 этого листа суем массив ar2
    Application.Calculation = 1 'вкл автопересчет формул
    Application.ScreenUpdating = 1 'вкл обновление экрана
End Sub