SuitsColors3

Sub test()
Dim rngCell As Range
Dim CharCount As Integer
Dim BracketBegin As Integer
Dim BracketEnd As Integer
Dim strToColour As String
Dim riverBegin As Integer
Dim riverEnd As Integer
Dim sh, s$, j$()
On Error GoTo errr
X = Cells(Rows.Count, 1).End(xlUp).Row
For Each sh In Range("A5:B" & X & "")  ' A5:B это диапозон в котором происходит макрос, '
' если будут еще 1 столбец то ставь A5:С и так далее '
' п.с нижний диапозон не надо указывать он красит по всем строкам которые есть в файле '
sh.Cells.Replace Trim$("s"), Trim$(ChrW(9824))
sh.Cells.Replace Trim$("c"), Trim$(ChrW(9827))
sh.Cells.Replace Trim$("h"), Trim$(ChrW(9829))
sh.Cells.Replace Trim$("d"), Trim$(ChrW(9830))
Next
errr:


For Each rngCell In Range("A5:B" & X & "") ' и вот тут тоже '
        ' first '
       CharCount = Len(rngCell)
        BracketBegin = 0
        If CharCount = 2 Then
        BracketEnd = Len(rngCell)
        Else
        BracketEnd = InStr(1, rngCell, " ")
        End If
    With rngCell.Characters(BracketBegin, BracketEnd)
        strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
        If InStr(strToColour, ChrW(9829)) Then
            .Font.Color = vbRed
        Else
        End If
    End With
        With rngCell.Characters(BracketBegin, BracketEnd)
        strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
        If InStr(strToColour, ChrW(9827)) Then
            .Font.Color = vbGreen
        Else
        End If
    End With
        With rngCell.Characters(BracketBegin, BracketEnd)
        strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
        If InStr(strToColour, ChrW(9830)) Then
            .Font.Color = vbBlue
        Else
        End If
    End With
        With rngCell.Characters(BracketBegin, BracketEnd)
        strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
        If InStr(strToColour, ChrW(9824)) Then
            .Font.Color = vbBlack
        Else
        End If
    End With
    ' second '
       BracketBegin = InStr(1, rngCell, " ")
        BracketEnd = InStr(2, rngCell, " ")
    With rngCell.Characters(BracketBegin, BracketEnd)
        strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
        If InStr(strToColour, ChrW(9829)) Then
            .Font.Color = vbRed
        Else
        End If
    End With
        With rngCell.Characters(BracketBegin, BracketEnd)
        strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
        If InStr(strToColour, ChrW(9827)) Then
            .Font.Color = vbGreen
        Else
        End If
    End With
        With rngCell.Characters(BracketBegin, BracketEnd)
        strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
        If InStr(strToColour, ChrW(9830)) Then
            .Font.Color = vbBlue
        Else
        End If
    End With
        With rngCell.Characters(BracketBegin, BracketEnd)
        strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
        If InStr(strToColour, ChrW(9824)) Then
            .Font.Color = vbBlack
        Else
        End If
    End With
    ' third '
       BracketBegin = 6
        BracketEnd = Len(rngCell)
    With rngCell.Characters(BracketBegin, BracketEnd)
        strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
        If InStr(strToColour, ChrW(9829)) Then
            .Font.Color = vbRed
        Else
        End If
    End With
        With rngCell.Characters(BracketBegin, BracketEnd)
        strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
        If InStr(strToColour, ChrW(9827)) Then
            .Font.Color = vbGreen
        Else
        End If
    End With
        With rngCell.Characters(BracketBegin, BracketEnd)
        strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
        If InStr(strToColour, ChrW(9830)) Then
            .Font.Color = vbBlue
        Else
        End If
    End With
        With rngCell.Characters(BracketBegin, BracketEnd)
        strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
        If InStr(strToColour, ChrW(9824)) Then
            .Font.Color = vbBlack
        Else
        End If
    End With
Next rngCell
End Sub