a_axe,
Код:

Private Sub UserForm_Initialize()
ComboBox1.List = Split("Черный,Красный,Зеленый,Желтый,Синий,Пурпурный,Циан,Белый", ",") 'заполняем выпадающее поле
End Sub
Private Sub CommandButton1_Click()
Dim strFindWhat As String
Dim strFirstFoundAddress As String
Dim objRange As Range
Dim intFoundPosition As Integer
strFindWhat = Val(TextBox1.Text) 'забираем данные из текстового поля
sFontColorAsk = ComboBox1.Text 'забираем данные из выпадающего поля
If sFontColorAsk = "Черный" Then sFontcolor = vbBlack
If sFontColorAsk = "Красный" Then sFontcolor = vbRed
If sFontColorAsk = "Зеленый" Then sFontcolor = vbGreen
If sFontColorAsk = "Желтый" Then sFontcolor = vbYellow
If sFontColorAsk = "Синий" Then sFontcolor = vbBlue
If sFontColorAsk = "Пурпурный" Then sFontcolor = vbMagenta
If sFontColorAsk = "Циан" Then sFontcolor = vbCyan
If 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
Теперь как уйти от If'ов?
Так же через Case?