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

Question

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

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

问题是搜索词包含通配符，如下所示：

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

星号“&”：（该网站不允许我输入星号，因为这是斜体的降价，所以我将输入 & 符号来绕过过滤器）开头的任意数量的字符的通配符一句话或最后。但与普通编程语言不同的是，当它在单词中间使用时，需要与连字符组合起来作为一系列字符的通配符。例如，“th&-e”会拾取“there”，而“th&e”则不会。

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

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

我已经尝试过 VBA 中的 .MatchWildcard 属性，但尚未使其正常工作。我有一种感觉，它与替换文本有关，而不是搜索文本。

工作宏将采用以下内容作为其输入（故意忽略第一行，第二列是包含目标搜索词的行）：

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

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

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

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

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

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

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

从今天开始，即 2009 年 9 月 17 日，工作宏的代码将在 Pastebin 上发布一个月，网址如下。

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

莎拉

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

Answer 1

也许 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 来搜索字符串：

暗淡文本作为字符串文本=“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

变量文本的结果将是：

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

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

rngTable.Text as text

和

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

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

Answer 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