Использование подстановочных знаков в функции поиска и замены в макросе VBA для Microsoft Word
Вопрос
У меня есть макрос VBA для Microsoft Word, который я пытаюсь улучшить.
Цель макроса — выделить жирным шрифтом и курсивом все слова в документе, которые соответствуют критериям поиска в первой таблице документа.
Проблема в том, что поисковые запросы включают в себя следующие подстановочные знаки:
дефис "-":между буквами подстановочный знак для пробела или точки
звездочка "&":(сайт не позволяет мне вставлять звездочки, так как это уценка для курсива, поэтому вместо этого я вставлю символ &, чтобы обойти фильтры) подстановочный знак для любого количества символов в начале слова или в конце конец.Однако, в отличие от обычных языков программирования, когда он используется в середине слова, его необходимо объединить с дефисом, чтобы он стал подстановочным знаком для диапазона символов.Например, «th&-e» будет воспринимать «там», а «th&e» — нет.
вопросительный знак "?":подстановочный знак для одного символа
Пока что я просто проверяю эти символы, и если они присутствуют, я либо удаляю их в случае звездочки, либо предупреждаю пользователя, что ему придется искать слово вручную.Не идеально :-P
Я попробовал свойство .MatchWildcard в VBA, но пока не заработало.У меня такое ощущение, что это как-то связано с текстом замены, а не с текстом поиска.
Рабочий макрос будет принимать в качестве входных данных следующее (первая строка намеренно игнорируется, а второй столбец содержит целевые условия поиска):
Представьте себе это в таблице во втором столбце (поскольку разрешенный здесь HTML не допускает tr, td и т. д.)
Первая строка:Слово
Второй ряд:Поиск
Третий ряд:&earch1
Четвертый ряд:Поиск2&
Пятый ряд:S-поиск3
Шестой ряд:S?arch4
Седьмой ряд:С&-ч5
И он выполнит поиск в документе и заменит его содержимым, выделенным жирным шрифтом и курсивом, например:
Поиск Поиск1 Поиск2 Поиск3 Поиск4 Поиск5
Примечание:S-earch3 также может взять S.earch3 и заменить его на Search3.
Как можно предположить, условия поиска обычно не располагаются рядом друг с другом — макрос должен найти все экземпляры.
Я также включу свой опробованный, но нефункциональный код, после первого рабочего макроса.
Код рабочего макроса будет находиться на Pastebin в течение месяца, начиная с сегодняшнего дня, то есть 17 сентября 2009 года, по адресу: URL.
Еще раз спасибо за любые мысли и помощь, которую вы можете предложить!
Сара
Рабочий макрос VBA:
Sub AllBold()
Dim tblOne As Table
Dim celTable As Cell
Dim rngTable As Range
Dim intCount As Integer
Dim celColl As Cells
Dim i As Integer
Dim rngLen As Integer
Dim bolWild As Boolean
Dim strWild As String
Set tblOne = ActiveDocument.Tables(1)
intCount = tblOne.Columns(2).Cells.Count
Set celColl = tblOne.Columns(2).Cells
strWild = ""
For i = 1 To intCount
If i = 1 Then
i = i + 1
End If
Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)
Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
End:=celTable.Range.End - 1)
rngLen = Len(rngTable.Text)
bolWild = False
If (Mid(rngTable.Text, rngLen, 1) = "&") Then 'remember to replace & with asterisk!'
rngTable.SetRange Start:=rngTable.Start, End:=rngTable.End - 1
End If
If (Mid(rngTable.Text, 1, 1) = "&") Then 'remember to replace & with asterisk!'
rngTable.SetRange Start:=rngTable.Start + 1, End:=rngTable.End
End If
If InStr(1, rngTable.Text, "-", vbTextCompare) > 0 Then
strWild = strWild + rngTable.Text + Chr$(13)
bolWild = True
End If
If InStr(1, rngTable.Text, "?", vbTextCompare) > 0 Then
strWild = strWild + rngTable.Text + Chr$(13)
bolWild = True
End If
If (bolWild = False) Then
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Text = rngTable.Text
With .Replacement
.Text = rngTable.Text
.Font.Bold = True
.Font.Italic = True
End With
.Execute Replace:=wdReplaceAll
End With
End If
Next
If bolWild = True Then
MsgBox ("Please search the following strings with - or ? manually:" + Chr$(13) + strWild)
End If
End Sub
Попытка нефункционального макроса VBA:
Sub AllBoldWildcard()
Dim tblOne As Table
Dim celTable As Cell
Dim rngTable As Range
Dim intCount As Integer
Dim celColl As Cells
Dim i As Integer
Dim rngLen As Integer
Dim bolWild As Boolean
Dim strWild As String
Dim strWildcard As String
Set tblOne = ActiveDocument.Tables(1)
intCount = tblOne.Columns(2).Cells.Count
Set celColl = tblOne.Columns(2).Cells
strWild = ""
For i = 1 To intCount
If i = 1 Then
i = i + 1
End If
Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)
Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
End:=celTable.Range.End - 1)
rngLen = Len(rngTable.Text)
bolWild = False
If (Mid(rngTable.Text, 1, 1) = "&") Then 'remember to replace & with asterisk!'
rngTable.SetRange Start:=rngTable.Start + 1, End:=rngTable.End
End If
If InStr(1, rngTable.Text, "&", vbTextCompare) > 0 Then 'remember to replace & with asterisk!'
strWildcard = rngTable.Text
rngTable.Text = Replace(rngTable.Text, "&", "", 1) 'remember to replace & with asterisk!'
bolWild = True
End If
If InStr(1, rngTable.Text, "-", vbTextCompare) > 0 Then
strWildcard = Replace(rngTable.Text, "-", "[.-]", 1)
bolWild = True
End If
If InStr(1, rngTable.Text, "?", vbTextCompare) > 0 Then
strWild = strWild + rngTable.Text + Chr$(13)
strWildcard = Replace(rngTable.Text, "?", "_", 1)
bolWild = True
End If
If (bolWild = False) Then
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Text = strWildcard
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
With .Replacement
.Text = rngTable.Text
.Font.Bold = True
.Font.Italic = True
End With
.Execute Replace:=wdReplaceAll
End With
End If
Next
' If bolWild = True Then'
' MsgBox ("Please search the following strings with - or ? manually:" + Chr$(13) + strWild)'
' End If'
End Sub
Решение 2
Sub AllBold()
Dim tblOne As Table
Dim celTable As Cell
Dim rngTable As Range
Dim intCount As Integer
Dim intMatch As Integer
Dim celColl As Cells
Dim i As Integer
Dim strRegex As String
Dim Match, Matches
Set tblOne = ActiveDocument.Tables(1)
intCount = tblOne.Columns(2).Cells.Count
Set celColl = tblOne.Columns(2).Cells
Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True
For i = 1 To intCount
If i = 1 Then
i = i + 1
End If
Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)
Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
End:=celTable.Range.End - 1)
If rngTable.Text <> "" Then
strRegex = rngTable.Text
strRegex = Replace(strRegex, "*-", "[\w]{0,}[^\w]{0,1}[\w]{0,}", 1)
strRegex = Replace(strRegex, "*", "\w+", 1)
strRegex = Replace(strRegex, "-", "[^\w]{0,1}", 1)
strRegex = Replace(strRegex, "?", ".", 1)
objRegEx.Pattern = "\b" + strRegex + "\b"
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
Set Matches = objRegEx.Execute(ActiveDocument.Range.Text)
intMatch = Matches.Count
If intMatch >= 1 Then
rngTable.Bold = True
For Each Match In Matches
With oRng.Find
.ClearFormatting
.Text = Match.Value
With .Replacement
.Text = Match.Value
.Font.Bold = True
.Font.Italic = True
End With
.Execute Replace:=wdReplaceAll
End With
Next Match
End If
End If
Next i
End Sub
Другие советы
Возможно, вам поможет оператор LIKE:
if "My House" like "* House" then
end if
Обычные выражения:Найдите Search4 и замените его на SEARCH4 и используйте для этого подстановочные знаки:
Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True
'here you can enter your search with wild cards
'mine says "S" followed by any character followed by "arch" followed by 1-n numbers.
objRegEx.Pattern = "S.arch([0-9]+)"
newText = objRegEx.Replace("Test Search4", "SEARCH$1")
MsgBox (newText)
'gives you: Test SEARCH4
Дополнительную информацию о том, как использовать эти подстановочные знаки, можно найти. здесьПоначалу может быть сложно, но обещаю, вам понравится ;)
Вы также можете заменить use для поиска строк:
Dim Text As String Text = "Hello Search4 Search3 SAARCH2 SEARK0
Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True
'here you can enter your search with wild cards
'mine says "S" followed by any character followed by "arch" followed by 1-n numbers.
objRegEx.Pattern = "S.arch[0-9]+"
If (objRegEx.test(text) = True) Then
Dim objMatch As Variant
Set objMatch = objRegEx.Execute(text) ' Execute search.
Dim wordStart As Long
Dim wordEnd As Long
Dim intIndex As Integer
For intIndex = 0 To objMatch.Count - 1
wordStart = objMatch(intIndex).FirstIndex
wordEnd = wordStart + Len(objMatch(intIndex))
MsgBox ("found " & objMatch(intIndex) & " position: " & wordStart & " - " & wordEnd)
Next
End If
Результат для переменной text будет:
Search4 position: 6 - 13
Search3 position: 14- 21
...
Итак, в вашем коде вы должны использовать
rngTable.Text as text
и
rngTable.SetRange Start:=rngTable.Start + wordStart, End:=rngTable.Start + wordEnd
это диапазон, который вы хотите выделить жирным шрифтом.