выделить цветом слово внутри ячейки Excel, слова которые нужно найти и выделить предварительно нужно вписать в отдельный столбик(красный,зеленый,сини

Question

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

то есть:

создать три столбика (колонки) куда буду добавлять нужные мне слова на основании п.1 в основном тексте слова из списков будут выделяться определенным цветом Заранее благодарю за помощь.

Answer 1

Вот макрос, который раскрашивает слова в активной ячейке. Он даже меньше, чем комментарии к вашему вопросу.

Sub ColorizeWords()
  Dim i As Integer, j As Integer, k As Integer, l As Integer
  Dim w As String, m As Integer, c() As Variant
  Dim lj As Long, mj As Long
  c = Array(0, -16776961, -11489280, -4165632)
  mj = Columns(1).Rows.Count
  For i = 1 To 3
    lj = Cells(1, i).End(xlDown).Row
    If lj < mj Then
      For j = 2 To lj
        w = " " & Cells(j, i) & " "
        m = Len(w)
        k = 1
        l = InStr(k, ActiveCell, w)
        While l > 0
          ActiveCell.Characters(Start:=l + 1, Length:=m - 2).Font.Color = c(i)
          k = l + m
          l = InStr(k, ActiveCell, w)
        Wend
      Next
    End If
  Next
End Sub

Для макроса слово - это последовательность символов за исключением пробела, ограниченная пробелами. Поэтому макрос не найдёт слова в начале и в конце текста, где нет пробела с одной из строн; он не найдёт слова, ограниченные знаками препинания и другими символами. Над усовершенствованием макроса в этом плане вы можете подумать самостоятельно.

Усовершенствовал макрос. Цвета с верхней левой ячеки, произвольное количество, заголовки должны быть раскрашены в нужный цвет, обрабатывает все выделенные ячейки.

Sub ColorizeWords()
  Dim c As Integer, r As Integer, i As Integer, m As Integer
  Dim w As String, cc As Range, color As Long
  Dim lr As Long, mr As Long, mc As Long
  mr = Columns(1).Rows.Count
  mc = Cells(1, 1).End(xlToRight).Column
  If mc = Rows(1).Columns.Count Then mc = 1
  For Each cc In Selection.Cells
    For c = 1 To mc
      color = Cells(1, c).Font.color
      lr = Cells(1, c).End(xlDown).Row
      If lr < mr Then
        For r = 2 To lr
          w = " " & Cells(r, c) & " "
          m = Len(w)
          i = InStr(cc, w)
          While i > 0
            cc.Characters(Start:=i + 1, Length:=m - 2).Font.color = color
            i = InStr(i + m, ActiveCell, w)
          Wend
        Next
      End If
    Next
  Next
End Sub

Answer 2

Решение на базе регулярных выражений. На тестовых примерах корректно отрабатывает границы слов, которые могут быть отделены друг от друга не только пробелами, но и знаками препинания, небуквенными символами. Казалось бы, поставил \b вокруг подстроки и все дела. Но VBA RegEx не так [как хотелось бы] определяет границы слов для русских букв и не понимает просмотра назад, поэтому пришлось немного нагородить.

Option Explicit

Sub PaintText()
    If IsEmpty(ActiveSheet.Range("A1")) Then Exit Sub ' если в "таблице цветных подстрок" пусто, то сразу выходим
    ActiveCell.Font.color = vbBlack
    Dim txt, cl, substr, len_sub, color, RegEx, res, match
    
    Set RegEx = CreateObject("VBScript.RegExp")
    With RegEx
        .Global = True
        .IgnoreCase = True
        .MultiLine = True
    End With
    
    txt = ActiveCell    'вносим текст в переменную, чтобы минимизировать количество операций чтения ячейки
    For Each cl In ActiveSheet.Range("A1").CurrentRegion ' забираем связный диапазон, содержащий A1
        substr = cl.Text ' забирает из ячейки видимый текст, даже текст ошибок типа #ДЕЛ/0!
        len_sub = Len(substr)
        If len_sub Then
            color = cl.Font.color
            RegEx.Pattern = "(?:[^\wа-яА-ЯёЁ]|^)(" & substr & ")(?=[^\wа-яА-ЯёЁ]|$)"
            Set res = RegEx.Execute(txt)
            If res.Count > 0 Then
                For Each match In res
                    ActiveCell.Characters(match.firstindex + 1 + IIf(match.firstindex = 0, 0, 1), len_sub).Font.color = color
                Next
            End If
        End If
    Next
End Sub

БЛОГ НА HUSL

выделить цветом слово внутри ячейки Excel, слова которые нужно найти и выделить предварительно нужно вписать в отдельный столбик(красный,зеленый,сини

Ответы (2 шт):