Sub Выделение_ячеек_по_условию2()
Dim a As Range
  Set a = Test_выделение_ячеек_по_условию2(Selection, "*!*") ' (Диапазон для поиска, что ищем /обязательно с маской если формулы, то в английском варианте написания)
  If Not a Is Nothing Then a.Select
End Sub


Function Test_выделение_ячеек_по_условию2(FReg As Range, FStr As String) As Range
Dim ResR As Range, sAr As Range, firstAddress As String
With FReg
  Set sAr = .Find(FStr, LookIn:=xlFormulas, LookAt:=xlWhole) ' (что ищем, формулы или значения)
  If Not sAr Is Nothing Then
    firstAddress = sAr.Address
    Do
      If ResR Is Nothing Then
        Set ResR = sAr
      Else
        Set ResR = Union(ResR, sAr)
      End If
      Set sAr = .FindNext(sAr)
    Loop While Not sAr Is Nothing And sAr.Address <> firstAddress
  End If
End With
Set Test_выделение_ячеек_по_условию2 = ResR
End Function