MyTetra Share
Делитесь знаниями!
Формат части текста
Время создания: 16.03.2019 23:43
Текстовые метки: VBA, Text, Characters
Раздел: Разные закладки - VBA - Text
Запись: xintrea/mytetra_db_adgaver_new/master/base/148186125552xhz5lio4/text.html на raw.githubusercontent.com

http://www.sql.ru/forum/999360/cvet-chasti-teksta-v-yacheyke-v-vba


Как окрасить любой символ в любой цвет в тексте одной ячейки Excel
Например, в ячейке A1 в текстовом формате есть значение "123456789". Фон зададим светло-серый
For x = 1 To 9
With ActiveCell.Characters(Start:=x, Length:=1).Font
.ColorIndex = x
End With
Next x
Выделяем эту ячейку. Запускаем этот код. Получаем в ячейке символы разных цветов
1-черный, 2-белый, 3-красный, 4-зеленый, 5-синий, 6-желтый, 7-розовый, 8-голубой, 9-коричневый
Текст в ячейке задан цифрами для наглядности номеров цветов.


http://www.excelworld.ru/forum/2-19569-1

В принципе, текст в ячейке можно раскрасить так

Sub tt()
Dim S As String
Dim i As Long
    With Range("C3")
    For i = 1 To Len(.Value)
        S = Mid(.Value, i, 1)
        Select Case S
            Case "В": .Characters(i, 1).Font.Color = vbGreen
            Case "П": .Characters(i, 1).Font.Color = vbRed
            Case "Н": .Characters(i, 1).Font.Color = vbYellow
        End Select
    Next
    End With
End Sub


Но почему-то этот способ не работает с текстом полученным в результате сцепления. Так и не смог выяснить - почему? Возможно, кто-то знает ответ.
UPD
Как обходной варинат

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("A1:A5")) Is Nothing Then Exit Sub
[C3] = [A1] & [A2] & [A3] & [A4] & [A5]
    With Range("C3")
    For i = 1 To Len(.Value)
        S = Mid(.Value, i, 1)
        Select Case S
            Case "В": .Characters(i, 1).Font.Color = vbGreen
            Case "П": .Characters(i, 1).Font.Color = vbRed
            Case "Н": .Characters(i, 1).Font.Color = vbYellow
            Case Else: .Characters(i, 1).Font.Color = vbBlack
        End Select
    Next
    End With
End Sub

Так же в этом разделе:
 
MyTetra Share v.0.65
Яндекс индекс цитирования