[blackeangel]

Iska, спасибо, так и сделал. Еще сделал запрос цвета для выделения.

Код:

Sub colorr()
    Dim strFindWhat As String
    Dim strFirstFoundAddress As String
    Dim objRange As Range
    Dim intFoundPosition As Integer
    strFindWhat = InputBox("Введите что подкрасить")
    sFontColorAsk = InputBox("Введите один из цветов: " _
    & Chr(13) & "черный, красный, зеленый, желтый," _
    & Chr(13) & "синий, пурпурный, циан, белый")
    If sFontColorAsk = "черный" Or sFontColorAsk = "Черный" Then sFontColor = vbBlack
    If sFontColorAsk = "красный" Or sFontColorAsk = "Красный" Then sFontColor = vbRed
    If sFontColorAsk = "зеленый" Or sFontColorAsk = "Зеленый" Then sFontColor = vbGreen
    If sFontColorAsk = "желтый" Or sFontColorAsk = "Желтый" Then sFontColor = vbYellow
    If sFontColorAsk = "синий" Or sFontColorAsk = "Синий" Then sFontColor = vbBlue
    If sFontColorAsk = "пурпурный" Or sFontColorAsk = "Пурпурный" Then sFontColor = vbMagenta
    If sFontColorAsk = "циан" Or sFontColorAsk = "Циан" Then sFontColor = vbCyan
    If sFontColorAsk = "белый" Or sFontColorAsk = "Белый" Then sFontColor = vbWhite
    With ActiveSheet.UsedRange
        Set objRange = .Find( _
            What:=strFindWhat, _
            LookIn:=xlFormulas, _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            SearchFormat:=False _
        )
        If Not objRange Is Nothing Then
            strFirstFoundAddress = objRange.Address
            Do
                intFoundPosition = InStr(1, objRange.Value, strFindWhat, vbTextCompare)
                Do While intFoundPosition > 0
                    objRange.Characters(intFoundPosition, Len(strFindWhat)).Font.Color = sFontColor
                    intFoundPosition = InStr(intFoundPosition + 1, objRange.Value, strFindWhat, vbTextCompare)
                Loop
                Set objRange = .FindNext(After:=objRange)
            Loop Until objRange.Address = strFirstFoundAddress
        End If
    End With
End Sub

Если есть вариант проще, то это интересно.