如何在带有数组的 Word VBA 宏中使用通配符函数？

Question

我[在另一个线程中][1]发布了一个问题，寻求帮助以使 strSplit FindReplace 宏正常工作。蒂姆和保罗提供了有用的答案和示例宏。 Paul 建议使用数组方法代替 strSplit 方法的优点之一是播放速度更快。他的以数组为中心的示例还可以与任意数量的文本选择一起使用，而我原来的 strSplit 宏仅适用于一个单词，如果我选择更多，我就会遇到 Word 想要替换整个文档而不是替换的烦恼。只是选择。

Paul 的数组宏非常适合精确匹配，但现在我想使用数组的通配符函数来扩展选项。以下是使用通配符和 strSplit 方法查找“单词空间数字”字符串并替换为不带空格的实心数字的代码示例（例如“6 23”=“623”）。

Sub ecNUM_WSN_NumColNum()

Application.ScreenUpdating = False
Dim Char As String
Call ClearFindAndReplaceParameters

'use const for fixed values
    Const StrFind = "([Oo]ne) ([0-9]),([Tt]wo) ([0-9]),([Tt]hree) ([0-9])," & _
        "([Ff]our) ([0-9]),([Ff]ive) ([0-9]),([Ss]ix) ([0-9]),([Ss]even) ([0-9])," & _
        "([Ee]ight) ([0-9]),([Nn]ine) ([0-9]),([Tt]en) ([0-9])"
    Const StrRepl = "1:\2,2:\2,3:\2,4:\2,5:\2,6:\2,7:\2,8:\2,9:\2,10:\2"
    
    Dim arrF, arrR, I As Long
    
    arrF = Split(StrFind, ",")
    arrR = Split(StrRepl, ",")

    Debug.Print "Checking: " & Selection.Text
    For I = LBound(arrF) To UBound(arrF)
        With Selection.Find
            .Text = arrF(I)
            .MatchWildcards = True
            .Replacement.Text = arrR(I)
            .Wrap = wdFindStop
            .IgnorePunct = True
            .IgnoreSpace = True
        If .Execute(Replace:=wdReplaceOne) Then Exit For  'found one!'
            Selection.Find.Execute Replace:=wdReplaceOne
        End With
    Next I
    
Call ClearFindAndReplaceParameters
Selection.Collapse Direction:=wdCollapseEnd
Char = Selection.EndOf(Unit:=wdWord, Extend:=wdMove)
Application.ScreenUpdating = True
End Sub

上面的代码对于单个选择非常有效。但是，例如，如果我选择多行，它只会找到一个选择，因为它当然包含 ReplaceOne 指令。如果我将其更改为 ReplaceAll（并删除 If 语句），它会替换整个文档。

在原始线程中，Paul 的示例代码适用于精确匹配场景，适用于所选的任意数量的文本：

Sub ReplaceNextOrdinal()
Application.ScreenUpdating = False
Dim ArrFnd As Variant, ArrRep As Variant, RngFnd As Range, i As Long
'Array of Find expressions
ArrFnd = Array("first", "second", "third", "fourth", "fifth", "sixth", "seventh", "eighth", "ninth", "tenth")
ArrRep = Array("1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th", "10th")
Set RngFnd = ActiveDocument.Range(Selection.Words.First.Start, Selection.Words.Last.End)
For i = 0 To UBound(ArrFnd)
  With RngFnd.Duplicate
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .IgnorePunct = True
      .IgnoreSpace = True
      .MatchWholeWord = True
      .Text = ArrFnd(i)
    End With
    Do While .Find.Execute
      If .InRange(RngFnd) Then
        .Text = ArrRep(i)
        .Start = .Characters.Last.Previous.Start
        .Font.Superscript = True
      Else
        Exit Do
      End If
    Loop
  End With
Next i
Application.ScreenUpdating = True
End Sub

我一直在尝试创建保罗数组方法的通配符版本，但没有成功。我要么遇到大量编译错误，要么编译后什么也不做。下面是我删除 Do While 循环的最新尝试，因为这是一个不断触发编译错误的地方。我 99.99% 我仍然需要循环，但宏没有它。

我计划最终将目前具有数千行代码的数十个宏从非常基本的无穷无尽的 FindReplace 步骤字符串转换为这些不太臃肿的分割字符串和/或数组版本。一些宏将是“一次性”版本（这意味着我将在手动编辑文档时将它们用于选定文本的一小部分。其他宏将用于全局 FindReplace 函数（无需用户干预）。我猜我会需要在这两种情况下使用的任何宏的两个单独版本，我们将不胜感激！

谢谢！

凯伦:)

Sub ecNUM_WSN_NumColNum_ARRAY()
Application.ScreenUpdating = False
Dim ArrFnd As Variant, ArrRep As Variant, RngFnd As Range, I As Long

'Array of Find expressions
ArrFnd = Array("([Oo]ne) ([0-9])", "([Tt]wo) ([0-9])", "([Tt]hree) ([0-9])", _
    "([Ff]our) ([0-9])", "([Ff]ive) ([0-9])", "([Ss]ix) ([0-9])", _
    "([Ss]even) ([0-9])", "([Ee]ight) ([0-9])", "([Nn]ine) ([0-9])", _
    "([Tt]en) ([0-9])", "([Ee]leven) ([0-9])", "([Tt]welve) ([0-9])", _
    "([Tt]hirteen) ([0-9])", "([Ff]ourteen) ([0-9])", "([Ff]ifteen) ([0-9])", _
    "([Ss]ixteen) ([0-9])", "([Ss]eventeen) ([0-9])", "([Ee]ighteen) ([0-9])", _
    "([Nn]ineteen) ([0-9])")
ArrRep = Array("1\2", "2\2", "3\2", "4\2", "5\2", "6\2", "7\2", "8\2", "9\2", _
    "10\2", "11\2", "12\2", "13\2", "14\2", "15\2", "16\2", "17\2", "18\2", "19\2")

Set RngFnd = ActiveDocument.Range(Selection.Words.First.Start, Selection.Words.Last.End)
Call ClearFindAndReplaceParameters
For I = 0 To UBound(ArrFnd)

  With RngFnd.Duplicate
        With .Find
            .Text = ArrFnd(I)
            .MatchWildcards = True
            .Replacement.Text = ArrRep(I)
            .Wrap = wdFindStop
            .IgnorePunct = True
            .IgnoreSpace = True
              End With
            RngFnd.Find.Execute Replace:=wdReplaceAll
    End With
Next I
Application.ScreenUpdating = True
End Sub

具有用于单字选择的多个查找/替换选项的 Word VBA 宏仅在选择包含第一个 F/R 选项时才有效

Answer 1

请尝试更换

If .Execute(Replace:=wdReplaceOne) Then Exit For  'found one!'
Selection.Find.Execute Replace:=wdReplaceOne

与

.Execute Replace:=wdReplaceAll