2009-09-17 61 views
3

我有Microsoft Word中,我试图提高VBA宏。获取通配符在找工作和替换VBA宏功能的Microsoft Word

宏的目的是大胆和斜体文档中的匹配在文档的第一个表中的搜索词的所有单词。

问题是搜索术语包括通配符,其有以下几种:

连字符“ - ”:字母之间为空格或一个周期

星号“&”通配符:(站点是不让我加星号,因为这是斜体的降序,所以我会放入&符号,而不是绕过滤波器)在单词开头或末尾处的任意数量字符的通配符。与普通的编程语言不同,当它用在单词的中间时,它需要与连字符组合以作为一系列字符的通配符。例如,“th & -e”将拾起“there”,而“th & e”不会。

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

什么我到目前为止做的只是测试了这些字符,如果存在的话,我不是垂耳他们关中星号的情况下,还是我提醒用户他们必须手动搜索该词。不理想:-P

我曾尝试在VBA中.MatchWildcard财产,但还没有得到它的工作。我有一种感觉,它与替换文本有关,而不是搜索文本。

一个工作宏将采取以下作为其输入(在第一行被有意忽略,第二列是一个与目标搜索字词):

所有在第二列设想这样一个表中(作为HTML这里不允许不允许TR和TD等)

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

它将搜索文档,并与粗斜体内容替换像这样:

搜索搜索1搜索2 Search3 Search4 Search5

注:Search3也可以拿起S.earch 3,用Search3

更换正如人们所设想的搜索词通常不会被旁边的对方 - 宏应该找到所有实例。

我会包含我的企图,但非功能代码以及之后的第一个工作日宏。

工作宏的代码将从今天开始用于一个月的pastebin,即2009年9月17日的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 

回答

1
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 
+0

所以最后,我发现我无法使用Match.FirstIndex,因为文档设置的方式让这些表丢掉了。我最终使用匹配For Each中的Word Find查找Match.Value,而不是使用范围。这是我正在寻找的确切解决方案。 @ghommey没有你,我无法做到 - 在我们两个人之间,这个解决方案完美解决。 – saranicole 2009-09-25 23:58:03

+0

很高兴听到我可以帮助你 – jantimon 2009-09-27 17:48:54

1

也许LIKE语句可以帮助你:

if "My House" like "* House" then 

end if 

定期EXPRES sions: 搜索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 

了解更多信息的通配符使用如何可以发现here 这可能是开头难,但我保证你会爱上它;)

可以更换使用搜索字符串太:

昏暗的文本作为字符串 文本= “你好Search4 search3 sAarch2搜索0搜索”

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 

会成为你想的范围内设置为粗体。

+1

感谢发布!这听起来是正确的,但我试图找到一个代码示例来说明如何在搜索和替换中使用“like”。幸运的是,英文中经常使用“like”这个词来表示除代码以外的其他内容,所以我在搜索引擎上搜索引擎时遇到了麻烦! ;-) 您可以使用VBA查找或链接指向我的指导说明它的代码的示例吗? 非常感谢! – saranicole 2009-09-17 14:08:07

+0

你有多甜?感谢代码 - 我注意到这是在VBScript - 将与VBA兼容?我不认为VBA支持正则表达式,只是通配符(否则这是我第一次走了。要喜欢MS Office开发:-P) – saranicole 2009-09-17 16:00:00

+0

欢迎您。我尝试使用MS Word 2008的示例代码没有任何问题。 VBA是afaik VBScript加上MS Office Api。 – jantimon 2009-09-17 16:07:33