让通配符在Microsoft Word的VBA宏中的查找和替换函数中工作

让通配符在Microsoft Word的VBA宏中的查找和替换函数中工作,vba,replace,ms-word,wildcard,Vba,Replace,Ms Word,Wildcard,我有一个Microsoft Word的VBA宏,我正在努力改进 宏的目的是将文档中与文档第一个表中的搜索词匹配的所有单词加粗并斜体化 问题在于搜索词包含以下通配符: 连字符“-”:字母之间为空格或句点的通配符 星号“&”:(该网站不允许我输入星号,因为这是斜体的标记,因此我将输入&符号,以绕过过滤器)在单词开头或结尾添加任意数量字符的通配符。与普通的编程语言不同,当它在单词的中间使用时,它需要与连字符组合成为一系列字符的通配符。例如,“th&e”会选择“there”,而“th&e”不会 问号“?

我有一个Microsoft Word的VBA宏,我正在努力改进

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

问题在于搜索词包含以下通配符:

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

星号“&”:(该网站不允许我输入星号,因为这是斜体的标记,因此我将输入&符号,以绕过过滤器)在单词开头或结尾添加任意数量字符的通配符。与普通的编程语言不同,当它在单词的中间使用时,它需要与连字符组合成为一系列字符的通配符。例如,“th&e”会选择“there”,而“th&e”不会

问号“?”:单个字符的通配符

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

我在VBA中尝试了.MatchWildcard属性,但尚未使其正常工作。我感觉它与替换文本有关,而不是搜索文本

工作宏将以下内容作为其输入(有意忽略第一行,第二列是包含目标搜索项的行):

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

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

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

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

注意:S-earch3也可以拾取S.earch3并替换为Search3

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

在第一个工作宏之后,我将包括我尝试过的但没有功能的代码

工作宏的代码将在pastebin上保存一个月,从今天开始,即2009年9月17日,时间如下

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

萨拉

工作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
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
尝试的非功能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
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

或许类似的声明可以帮助您:

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
可以找到如何使用这些通配符的更多信息 一开始可能很难,但我保证你会喜欢的;)

您也可以使用替换来搜索字符串:

将文本变暗为字符串 text=“Hello Search4 search3 sAarch2 search0搜索”

变量文本的结果为:

Search4 position: 6 - 13
Search3 position: 14- 21
...
因此,在您的代码中,您将使用

rngTable.Text as text

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

Sub AllBold()
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
像桌子一样昏暗 暗淡的细胞 可调暗范围 Dim intCount为整数 整数形式的整数匹配 暗淡的细胞 作为整数的Dim i 作为字符串的Dim stregex 暗淡的火柴 Set tblOne=ActiveDocument.Tables(1) intCount=tblOne.Columns(2.Cells.Count) 设置celColl=tblOne.Columns(2.Cells) 设置objRegEx=CreateObject(“vbscript.regexp”) objRegEx.Global=True objRegEx.IgnoreCase=True objRegEx.MultiLine=True 对于i=1到整数计数 如果i=1,那么 i=i+1 如果结束 设置celTable=ActiveDocument.Tables(1).Cell(行=i,列=2) 设置rngTable=ActiveDocument.Range(开始:=celTable.Range.Start_ 结束:=celTable.Range.End-1) 如果为rngTable.Text“”,则 stregex=rngTable.Text strRegex=Replace(strRegex,“*-”,“[\w]{0,}[^\w]{0,1}[\w]{0,}”,1) stregex=Replace(stregex,“*”,“\w+”,1) strRegex=Replace(strRegex,“-”,“[^\w]{0,1}”,1) strRegex=替换(strRegex,“?”,“,”,1) objRegEx.Pattern=“\b”+stregex+“\b” 暗淡的颜色如单词范围 Set oRng=ActiveDocument.Range Set Matches=objRegEx.Execute(ActiveDocument.Range.Text) intMatch=Matches.Count 如果intMatch>=1,则 rngTable.Bold=True 比赛中的每一场比赛 和奥恩一起找 .ClearFormatting .Text=Match.Value 替换 .Text=Match.Value .Font.Bold=True .Font.Italic=True 以 .Execute Replace:=wdReplaceAll 以 下一场比赛 如果结束 如果结束 接下来我 端接头
感谢您的发帖!这听起来是对的,但我正试图找到一个代码示例来说明在搜索和替换中如何使用“like”。幸运的是,“like”这个词在英语中经常被用来表示代码以外的其他意思,所以我在搜索引擎上遇到了麻烦您可以发布一个使用VBA Find的代码示例,或是一个指向说明它的教程的链接吗?非常感谢!你有多甜蜜??谢谢你的代码-我注意到这是在vbscript中-这与VBA兼容吗?我不认为VBA支持正则表达式,只支持通配符(否则这是我会选择的第一件事。我会喜欢MS Office开发:-P)不客气。我使用MS Word 2008尝试了该示例代码,没有出现任何问题。VBA是一个AIK VBScript加上MS Office Api。这很有帮助!还是有点被粗体格式部分卡住了。因为我使用Find方法向替换文本添加粗体格式,所以