Добрый вечер. Прошу направить или подсказать в каком направлении двигаться, необходимо в тексте выделить все совпадения по маске красным шрифтом. Есть макрос который ищет совпадения и выделяет все совпавшие значения в тексте, проблема в том, что на данном этапе он выделяет абсолютно все совпадения, например в тексте есть обозначения м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
необходимо в тексте выделить все совпадения по маске
Период не рассматривал. Результат в столбце 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, спасибо Вам огромное, то что нужно. Я тоже хотел изначально реализовать, через регулярные выражения, но пока моих знаний не достаточно . Спасибо еще раз