Страницы: 1
RSS
Как выделить шрифт текста красным цветом по шаблону/маске?
 
Добрый вечер.
Прошу направить или подсказать в каком направлении двигаться, необходимо в тексте выделить все совпадения по маске красным шрифтом. Есть макрос который ищет совпадения и выделяет все совпавшие значения в тексте, проблема в том, что на данном этапе он выделяет абсолютно все совпадения, например в тексте есть обозначения м3 (метр кубический) и значение 3 выделять не надо, т.к. это обозначение, а не значение.
Макрос взять из статьи,
Буду благодарен за любую помощь.
Код
Sub Color()
    Range("A2:A18").Select
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Dim c As Range, i As Long
     For Each c In Range("B2:B19") 'Selection
        For i = 1 To Len(c)
            If Mid$(c, i, 1) Like "[0-9.,():]" Then c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
    Next i, c
End Sub
 
Что с первой Вашей темой? Вы как-то стесняетесь там написать чего-нибудь...
 
vikttur, я там отписывался и файл с решением выкладывал, до этого все было.Почему то все удалилось.
Может какой сбой был.
 
Цитата
необходимо в тексте выделить все совпадения по маске
Период не рассматривал. Результат в столбце D
Код
Sub iDidgits()
Dim mo As Object
Dim n As Integer
Dim i As Long
 With CreateObject("VBScript.RegExp")
   .Global = True
   .IgnoreCase = True
   .MultiLine = True
   .Pattern = "(\d )?\d+(,\d+)?(?= м3| тонн| машин| ТС)"
  For i = 2 To 19
     If .test(Cells(i, 1)) Then
         Cells(i, 1).Copy Cells(i, 4)
       Set mo = .Execute(Cells(i, 1))
         For n = 0 To mo.Count - 1
           Cells(i, 4).Characters(mo(n).FirstIndex + 1, mo(n).Length).Font.ColorIndex = 3
         Next
    End If
   Next
 End With
End Sub
 
Kuzmich, спасибо Вам огромное, то что нужно.
Я тоже хотел изначально реализовать, через регулярные выражения, но пока моих знаний не достаточно :) . Спасибо еще раз
Страницы: 1
Наверх