макрос изменения цвета шрифта ячейки, при наличии определенной буквы

[Alex_91]

доброго времени суток. вообщем такой вопрос.
посредством vba нужен макрос, который ищет определенную букву в ячейках и если данная буква присутствует то закрашивает содержимое ячейки в определнный цвет(меняет шрифт) а если нет той буквы то не меняет ничего.

[IgorGO]

не нужен Вам макрос.
задача решается с помощью условного форматирования.

хотя с другой стороны, если макрос писать не Вам, а с условным форматированием разбираться лично Вам - то проще пусть "добрый дядя" макрос напишет

[Alex_91]

надо именно через макрос...

[staniiislav]

Сообщение от Alex_91

надо именно через макрос...

Выделите диапазон поиска и нажмите на кнопку, впишите что нужно искать

[Alex_91]

вот у меня макрос, он разлагает содержимое столбца ячейки разделенные пробелом на составляющие, где каждый разделенный компонент будет оформлен отдельным стоолбцом. и тут же надо изменить шрифт той ячейки где содержиться символ "h" на красный цвет.

Sub mak()
Dim d As String
Dim dl As String
Dim qw() As String
y = 0
NumRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To NumRow
s = Cells(i, 1)
qw = Split(s)
For k = LBound(qw) To UBound(qw)
If qw(k) <> "" Then
y = y + 1

IF INSTR(qw(k),"h")THEN COLUMNS(Y+1).Font.ColorIndex = 3

Cells(i, y + 1) = qw(k)
End If
Next k
y = 0
Next i
End Sub

разделять то разделяет а вот с изменением шрифта какие то проблемы.ы

[Alex_91]

а с условным форматирование то для поиска там нужна не только буква "h" а чтобы перекрашивало даже слово в котором содержиться эта буква

[IgorGO]

минус вложенного файла - там нет макросов,
плюс - закрашиваются все ячейки содержащие символ "h".
если в колонке А будет тысяча или 100 тысяч значений - без всяких макросов все может быть закрашено за 20-30 секунд.

[Alex_91]

ладно с условным форматированием, а вот в чем ошибка моего макроса? почему не так закрашивает?

[Alex_91]

Sub qw()


Dim d As String
Dim dl As String
Dim qw() As String
y = 0
NumRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To NumRow
  s = Cells(i, 1)
  qw = Split(s)
  For k = LBound(qw) To UBound(qw)
    If qw(k) <> "" Then
      y = y + 1
 
      
     If InStr(qw(k), "h") Then
     Cells(i, y + 1).Font.ColorIndex = 3
     Else
     Cells(i, y + 1).Font.ColorIndex = 1
        End If
        
        
      Cells(i, y + 1) = qw(k)
    End If
  Next k
  y = 0
Next i
End Sub

вот доделал))кому может пригодиться)))