18 февраля 2015

Кравченко Виктор

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

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

RegExp, Office, Word, VBA, Search, Replace, regular expressions

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

Private Sub Выполнить_RegExp(pattern As String, patternExpr As String) ...

14

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

15

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

16

Что почитать:

17

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

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

comments powered by HyperComments