使通配符在 Microsoft Word 的 VBA 宏中的查找和替换功能中工作

Getting wildcards to work in find and replace function in VBA macro for Microsoft Word

提问by saranicole

I have a VBA macro for Microsoft Word that I am trying to improve.

我有一个用于 Microsoft Word 的 VBA 宏，我正在尝试改进。

The purpose of the macro is to bold and italicize all words in a document that match the search terms in the first table of the document.

该宏的目的是将文档中与文档第一个表格中的搜索词匹配的所有单词加粗和斜体。

The problem is the search terms include wildcards which are the following:

问题是搜索词包括以下通配符：

the hyphen "-": between letters a wildcard for either a space or a period

连字符“-”：字母之间的空格或句点的通配符

asterisk "&": (the site is not letting me put in asterisks as this is the markdown for italicize, so I'll put in the & symbol instead to get around the filters) a wildcard for any number of characters at the beginning of a word or at the end. Unlike normal programming languages though, when it is used in the middle of the word it needs to be combined with the hyphen to be a wildcard for a range of characters. For example "th&-e" would pick up "there" while "th&e" would not.

星号“&”：（该站点不允许我输入星号，因为这是斜体的降价，所以我将输入 & 符号来代替过滤器）在开头的任意数量字符的通配符一个字或结尾。然而，与普通的编程语言不同，当它用在单词中间时，它需要与连字符组合成为一系列字符的通配符。例如，“th&-e”会选择“there”，而“th&e”则不会。

question mark "?": wildcard for a single character

问号“？”：单个字符的通配符

What I am doing so far is just testing for these characters and if they are present I either lop them off in the case of the asterisk, or I alert the user that they have to search for the word manually. Not ideal :-P

到目前为止我所做的只是测试这些字符，如果它们存在，我要么在星号的情况下将它们删除，要么提醒用户他们必须手动搜索该词。不理想：-P

I have tried the .MatchWildcard property in VBA but have not yet gotten it to work. I have a feeling it has something to do with the replacement text, not the search text.

我已经在 VBA 中尝试过 .MatchWildcard 属性，但还没有让它工作。我有一种感觉，它与替换文本有关，而不是搜索文本。

A working macro will take the following as its input (the first row is intentionally ignored and the second column is the one with the target search terms):

工作宏将以下内容作为其输入（第一行被有意忽略，第二列是目标搜索词）：

Imagine this in a table all in the second column (as the html allowed here doesn't allow tr and td etc)

想象一下这个在第二列的表格中（因为这里允许的 html 不允许 tr 和 td 等）

First row: Word
Second row: Search
Third row: &earch1
Fourth row: Search2&
Fifth row: S-earch3
Sixth row: S?arch4
Seventh row: S&-ch5

第一行：Word
第二行：Search
第三行：&earch1
第四行：Search2 &
第五行：S-earch3
第六行：S?arch4
第七行：S&-ch5

And it will search the document and replace with bold and italicized content like so:

它将搜索文档并替换为粗体和斜体内容，如下所示：

Search Search1 Search2 Search3 Search4 Search5

搜索 搜索 1 搜索 2 搜索 3 搜索 4 搜索 5

Note: S-earch3 could also pick up S.earch3 and replace with Search3

注意：S-earch3 也可以选取 S.earch3 并替换为 Search3

As one might assume the search terms will usually not be right next to each other - the macro should find all instances.

人们可能会假设搜索词通常不会彼此相邻 - 宏应该找到所有实例。

I will include my attempted but nonfunctional code as well after the first working macro.

我将在第一个工作宏之后包含我尝试过但不起作用的代码。

The code for the working macro will be on pastebin for a month from today, which is 9/17/09, at the following url.

从今天（2009 年 9 月 17 日）开始，工作宏的代码将在 pastebin 上保存一个月，位于以下url。

Thanks again for any thoughts and help you might have to offer!

再次感谢您提供的任何想法和帮助！

Sara

萨拉

Working VBA Macro:

工作 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

Attempted Nonfunctional VBA Macro:

尝试非功能性 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

采纳答案by saranicole

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

回答by jantimon

Maybe the LIKE statement could help you:

也许 LIKE 语句可以帮助您：

if "My House" like "* House" then

end if

Regular Expressions: Searching for Search4 and replace it by SEARCH4 and using wildcards to achieve that:

正则表达式：搜索 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")
MsgBox (newText) 
'gives you: Test SEARCH4

More information how those wildcards to use can be found hereIt might be hard in the beginning but I promise you will love it ;)

可以在此处找到如何使用通配符的更多信息 一开始可能很难，但我保证你会喜欢它 ;)

You can replace use to search for strings too:

您也可以替换 use 来搜索字符串：

Dim text As String text = "Hello Search4 search3 sAarch2 search0 search"

Dim text As String text = "Hello Search4 search3 sAarch2 search0 search"

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

The result for the variable text would be:

变量文本的结果将是：

Search4 position: 6 - 13
Search3 position: 14- 21
...

So in your code you would use

所以在你的代码中你会使用

rngTable.Text as text

and

和

rngTable.SetRange Start:=rngTable.Start + wordStart, End:=rngTable.Start + wordEnd

would be the range you want to set bold.

将是您要设置为粗体的范围。