18 февраля 2015
Кравченко Виктор

Как осуществить поиск и замену текста в MS Word 2007 (и более поздних версий) посредством регулярных выражений (а не подстановочных символов)

Регулярные выражения VBA (Visual Basic for Applications) VB
01

Все кто когда-либо сталкивался с подстановочными символами (Wildcards) знают, что это достаточно убогая попытка реализовать в VBA механизм подобный регулярным выражениям в других более развитых языках. Помимо более скудных возможностей (я уже не говорю о невозможности указания количества «ноль-или-один») данный механизм также ограничен и в сложности выстраиваемых выражений, и те кто пытался решить более-менее сложные задачи не раз сталкивался с ошибкой Поле "Найти" содержит слишком сложное выражение с использованием подстановочных символов. Отсюда и возникла необходимость воспользоваться более могущественным инструментом — регулярными выражениями.

02 VBA
1
2
3
4
5
6
7
8
9
10
11
Dim objRegExp, matches, match ' В первую очередь получаем объект VBScript.RegExp Set objRegExp = CreateObject("VBScript.RegExp") ' Далее задаем основные параметры With objRegExp .Global = True .IgnoreCase = False .pattern = "pattern" End With
03

Здесь, конечно, каждый кодер обрадуется — вызываем Replace и все ок!

04 VBA
1
Set matches = objRegExp.Replace(ActiveDocument.Content, "replacementstring")
05

Но при запуске, конечно же, будет выдана ошибка. Это связано с тем, что метод Replace объекта VBScript.RegExp принимает на вход первым параметром строковую переменную, а не объект (в нашем случае ActiveDocument.Content), и возвращает этот метод также измененную строку, а не вносит изменение во входящую, отсюда и танцы с бубнами:

06 VBA
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Set matches = objRegExp.Execute(ActiveDocument.Content) ' Придется обрабатывать каждое вхождение For Each match In matches Set matchRange = ActiveDocument.Content With matchRange.Find .Text = match.Value .Replacement.Text = "replacementstring" .MatchWholeWord = True .MatchCase = True .Forward = True .Wrap = wdFindStop .Format = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .Execute Replace:=wdReplaceOne End With Next
07

Ну хорошо, скажете вы, ну а если нам нужно переформатировать данные по аналогии с выражениями типа $1-$3-$2 (т. н. «обратные ссылки» в регулярных выражениях), т. е. как к примеру из 926-5562214 получить +7 (926) 556-22-14. Это тоже достаточно просто, здесь они тоже есть — единственное отличие — нумерация найденных групп начинается не с нуля, а единицы — $1. Давайте пока отвлечемся от нашего документа и посмотрим как это можно сделать с обычной строковой переменной:

08 VBA
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim objRegExp, matches, match Set objRegExp = CreateObject("VBScript.RegExp") Dim strSearch As String Dim strResult As String strSearch = "Пусть у нас есть несколько телефонов 8495-3584512, 8800-4852620 и, к примеру, 8950-5628585" With objRegExp .Global = True .IgnoreCase = False
.pattern = "8(\d{3})-(\d{3})(\d{2})(\d{2})"
End With strResult = objRegExp.Replace(strSearch, "+7 ($1) $2-$3-$4") Debug.Print strResult
' Результат: ' Пусть у нас есть несколько телефонов +7 (495) 358-45-12, +7 (800) 485-26-20 и, к примеру, +7 (950) 562-85-85
09 На заметку:
12 строка выделена для того чтобы подчеркнуть каким образом было разделено указание на подгруппы ($2, $3 и $4), ведь выражение (\d{3})(\d{2})(\d{2}) эквивалентно (\d{7}). Но во втором случае, рекурсивный запрос содержал бы все 7 цифр.
Изучайте регулярные выражения!
10

Но поскольку, как уже говорилось выше, вместо входной строки у нас объект ActiveDocument.Content, такой метод не подойдет для работы. Придется пойти на хитрость — объединить два предыдущих кода:

11 VBA
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Set objRegExp = CreateObject("VBScript.RegExp") With objRegExp .Global = True .IgnoreCase = False .pattern = "8(\d{3})-(\d{3})(\d{2})(\d{2})" End With Set matches = objRegExp.Execute(ActiveDocument.Content) Dim strReplacement As String For Each match In matches Set matchRange = ActiveDocument.Content ' Перед каждой заменой заранее формируем строку, которой нужно будет заменить вхождение strReplacement = objRegExp.Replace(match.Value, "+7 ($1) $2-$3-$4") With matchRange.Find .Text = match.Value .Replacement.Text = strReplacement .MatchWholeWord = True .MatchCase = True .Forward = True .Wrap = wdFindStop .Format = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .Execute Replace:=wdReplaceOne End With Next
12

Оборачиваем в оболочку-функцию и, вуаля:

13 VBA
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub ВыполнитьГруппуПреобразований_RegExp() Call Выполнить_RegExp("8(\d{3})-(\d{3})(\d{2})(\d{2})", "+7 ($1) $2-$3-$4") ' ... End Sub
Private Sub Выполнить_RegExp(pattern As String, patternExpr As String) Set objRegExp = CreateObject("VBScript.RegExp") With objRegExp .Global = True .IgnoreCase = False .pattern = pattern End With Set matches = objRegExp.Execute(ActiveDocument.Content) Dim strReplacement As String For Each match In matches Set matchRange = ActiveDocument.Content ' Перед каждой заменой заранее формируем строку, которой нужно будет заменить вхождение strReplacement = objRegExp.Replace(match.Value, patternExpr) With matchRange.Find .Text = match.Value .Replacement.Text = strReplacement .MatchWholeWord = True .MatchCase = True .Forward = True .Wrap = wdFindStop .Format = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .Execute Replace:=wdReplaceOne End With Next End Sub
14

Нельзя умолчать о существовании, к сожалению, некоторых ограничений в синтаксисе регулярных выражений при использовании объекта VBScript.RegExp в VBA. Эти ограничения провоцируют ошибку Run-time error '5017' Application-defined or object-defined error. Вот некоторые из них:

15
  • отсутствуют указатели на начало и конец текста \A и \Z — вместо этих указателей можно использовать указатель конца текста $;
  • отсутствуют назад- (?<=...) и впередсмотрящие (?=...) указатели (утверждения, lookbehind assertions), равно как и их отрицательные реализации — (?!=...) и (?!...);
  • отсутствует ряд модификаторов.
17

Похожие запросы:

  • Регулярные выражения в MS-Word
  • VBA regular expression, replacing groups
  • Поиск и замена текста с помощью объекта VBScript.RegExp
  • Замена текста в документе при помощи регулярных выражений
  • Regex Capture Groups and Back-References
  • Разработка регулярного выражения для разбора строки с помощью обратных ссылок
comments powered by HyperComments