Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy

=ЕСЛИ(ИЛИ(НЕ(ЕОШ(ПОИСК({"35""";"40""";"50""";"55"""};A1))));"ДА";"НЕТ")

    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "Бюрократ ([\S]*\/) \(([A-z]*)\)"
        For Each Rnb In Selection: Rnb.Value = .Replace(Rnb.Value, "$1" & "$2")
    Next
  End With

Sub ДУБЛИ_ВЯЧЕЙКЕ_УДЛАИТЬ()
    Dim col As New Collection
    Dim i As Integer
    On Error Resume Next
 
    For Each cell In Selection
        Set col = Nothing
        sResult = ""
         
        'делим текст в ячейке по пробелам
        arWords = Split(WorksheetFunction.Trim(cell.Value), " ")
         
        'проходим в цикле по всем получившимся словам
        For i = LBound(arWords) To UBound(arWords)
            Err.Clear                           'сбрасываем ошибки
            col.Add arWords(i), arWords(i)      'пробуем добавить слово в коллекцию
            'если ошибки не возникает, то это не повтор - добавляем слово к результату
            If Err.Number = 0 Then sResult = sResult & " " & arWords(i)
        Next i
        cell.Value = Trim(sResult)      'выводим результаты без повторов
    Next cell
End Sub

Sub bb()
Dim c As Range, x
With CreateObject("scripting.dictionary")
  For Each c In Selection
    .RemoveAll
    For Each x In Split(c)
      .Item(x) = 0
    Next
    c = Join(.keys)
  Next
End With
End Sub