Private Sub Worksheet_Change(ByVal Target As Range) 'любые изменения на листе
Dim i As Long
Dim iLastRow
Dim iДата As Object
With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "от (\d{1,2}\.\d{1,2}\.\d{2,4})"
iLastRow = Range("A2").End(xlDown).Row
Range("A2:A" & iLastRow).Font.ColorIndex = 0
Range("A2:A" & iLastRow).Font.Bold = False
For i = 2 To iLastRow
    If .Test(Cells(i, "A")) Then
        Set iДата = .Execute(Cells(i, "A"))(0)

'1-е УФ форматривание: Если дата очередной поверки больше сегоднешней то "красное" (просроченная проверка оборудования)
'=ДАТА(ГОД(ПСТР(A2;ПОИСК("г.";A2;1)-10;10))+1;МЕСЯЦ(ПСТР(A2;ПОИСК("г.";A2;1)-10;10));ДЕНЬ(ПСТР(A2;ПОИСК("г.";A2;1)-10;10)))>G2

    If CDate(.Execute(Cells(i, "A"))(0).SubMatches(0)) < Range("G2") Then

        With Cells(i, "A").Characters(Start:=iДата.firstindex + 4, _
                        Length:=iДата.Length - 3).Font
                    .ColorIndex = 3 'окрашивание в красный
                    .FontStyle = "полужирный курсив" 'выделение полужирным
                    .Underline = xlUnderlineStyleSingle  'подчеркивание текста
        End With
        
'2-е УФ форматривание: Если дата очередной поверки равна сегоднешней дате то "зеленое" (оборудование подошло к поверке)
'=ДАТА(ГОД(ПСТР(A2;ПОИСК("г.";A2;1)-10;10))+1;МЕСЯЦ(ПСТР(A2;ПОИСК("г.";A2;1)-10;10));ДЕНЬ(ПСТР(A2;ПОИСК("г.";A2;1)-10;10)))=G2

    ElseIf CDate(.Execute(Cells(i, "A"))(0).SubMatches(0)) = Range("G2") Then
        
        With Cells(i, "A").Characters(Start:=iДата.firstindex + 4, _
                        Length:=iДата.Length - 3).Font
                        .ColorIndex = 4 'окрашивание в зеленый
                        .FontStyle = "полужирный курсив" 'выделение полужирным
                        .Underline = xlUnderlineStyleSingle 'подчеркивание текста
                        End With
                        
'3-е УФ форматривание: Если дата очередной поверки меньше сегодняшней даты на два месяца то "желтое" (оборудование подлежит поверке и скоро будет просроченное)
'=ДАТА(ГОД(ПСТР(A2;ПОИСК("г.";A2;1)-10;10))+1;МЕСЯЦ(ПСТР(A2;ПОИСК("г.";A2;1)-10;10))-2;ДЕНЬ(ПСТР(A2;ПОИСК("г.";A2;1)-10;10)))<=ДАТАМЕС(ДАТА(ГОД(ПСТР(A2;ПОИСК("г.";A2;1)-10;10))+1;МЕСЯЦ(ПСТР(A2;ПОИСК("г.";A2;1)-10;10));ДЕНЬ(ПСТР(A2;ПОИСК("г.";A2;1)-10;10)));-2)
    
    ElseIf CDate(.Execute(Cells(i, "A"))(0).SubMatches(0)) < Range("G2") + 60 And _
            CDate(.Execute(Cells(i, "A"))(0).SubMatches(0)) > Range("G2") Then
        
        With Cells(i, "A").Characters(Start:=iДата.firstindex + 4, _
                        Length:=iДата.Length - 3).Font
                        .ColorIndex = 27 'окрашивание в желтый
                        .FontStyle = "полужирный курсив" 'выделение полужирным
                        .Underline = xlUnderlineStyleSingle 'подчеркивание текста
                        End With
    End If
    End If
Next
End With
End Sub