Question

我有一个宏，可以将数字前面的单引号更改为撇号（或关闭单个卷曲引号）。通常当你在单词中键入类似“80年代”的东西时，“8”前面的撇号面向错误的方式。下面的宏工作，但它非常慢（每页10秒）。在常规语言（甚至是解释的语言）中，这将是一个快速的过程。任何见解为什么在Word 2007上VBA需要这么长时间？或者，如果某人有一些能够在没有迭代的情况下执行此操作的查找+替换技能，请告诉我。

Sub FixNumericalReverseQuotes()
    Dim char As Range
    Debug.Print "starting " + CStr(Now)
    With Selection
        total = .Characters.Count
        ' Will be looking ahead one character, so we need at least 2 in the selection
        If total < 2 Then
            Return
        End If
        For x = 1 To total - 1
            a_code = Asc(.Characters(x))
            b_code = Asc(.Characters(x + 1))

            ' We want to convert a single quote in front of a number to an apostrophe
            ' Trying to use all numerical comparisons to speed this up
            If (a_code = 145 Or a_code = 39) And b_code >= 48 And b_code <= 57 Then
                .Characters(x) = Chr(146)
            End If 
        Next x
    End With
    Debug.Print "ending " + CStr(Now)
End Sub

Answer 1

除了两个指定的（为什么......？以及如何没有......？）之外还有一个隐含的问题 - 如何通过Word对象进行正确迭代采集。答案是 - 使用 obj .Next属性而不是索引访问。也就是说，而不是：

For i = 1 to ActiveDocument.Characters.Count
    'Do something with ActiveDocument.Characters(i), e.g.:
    Debug.Pring ActiveDocument.Characters(i).Text
Next

应该使用：

Dim ch as Range: Set ch = ActiveDocument.Characters(1)
Do
    'Do something with ch, e.g.:
    Debug.Print ch.Text
    Set ch = ch.Next 'Note iterating
Loop Until ch is Nothing

时间：00：03：30对00:00:06，超过3分钟对比6秒。

在Google上发现，链接丢失，抱歉。通过个人探索确认。

Answer 2

这是一个乞求正则表达式的问题。解决.Characters调用很多次可能是在性能上杀了你。

我做这样的事情：

Public Sub FixNumericalReverseQuotesFast()

    Dim expression As RegExp
    Set expression = New RegExp

    Dim buffer As String
    buffer = Selection.Range.Text

    expression.Global = True
    expression.MultiLine = True
    expression.Pattern = "[" & Chr$(145) & Chr$(39) & "]\d"

    Dim matches As MatchCollection
    Set matches = expression.Execute(buffer)

    Dim found As Match
    For Each found In matches
        buffer = Replace(buffer, found, Chr$(146) & Right$(found, 1))
    Next

    Selection.Range.Text = buffer

End Sub

注意：需要引用Microsoft VBScript正则表达式5.5（或后期绑定）。

修改不使用正则表达式库的解决方案仍然避免使用Ranges。这可以很容易地转换为使用字节数组代替：

Sub FixNumericalReverseQuotes() Dim chars() As Byte chars = StrConv(Selection.Text, vbFromUnicode) Dim pos As Long For pos = 0 To UBound(chars) - 1 If (chars(pos) = 145 Or chars(pos) = 39) _ And (chars(pos + 1) >= 48 And chars(pos + 1) <= 57) Then chars(pos) = 146 End If Next pos Selection.Text = StrConv(chars, vbUnicode) End Sub

基准测试（100次迭代，3页文本，100＆＃34;点击次数和＃34;每页）：

正则表达法：1.4375秒

数组方法：2.765625秒

OP方法:( 23分钟后完成任务）

大约是正则表达式的一半，但仍然大约每页10毫秒。

编辑2：显然上面的方法不是格式安全的，所以方法3：

Sub FixNumericalReverseQuotesVThree() Dim full_text As Range Dim cached As Long Set full_text = ActiveDocument.Range full_text.Find.ClearFormatting full_text.Find.MatchWildcards = True cached = full_text.End Do While full_text.Find.Execute("[" & Chr$(145) & Chr$(39) & "][0-9]") full_text.End = full_text.Start + 2 full_text.Characters(1) = Chr$(96) full_text.Start = full_text.Start + 1 full_text.End = cached Loop End Sub

同样，比上述两种方法都慢，但运行速度相当快（大约为ms）。

Answer 3

@ Comintern的修改版＆＃34;数组方法＆＃34;：

Sub FixNumericalReverseQuotes()
    Dim chars() As Byte
    chars = StrConv(Selection.Text, vbFromUnicode)

    Dim pos As Long
    For pos = 0 To UBound(chars) - 1
        If (chars(pos) = 145 Or chars(pos) = 39) _
        And (chars(pos + 1) >= 48 And chars(pos + 1) <= 57) Then
           ' Make the change directly in the selection so track changes is sensible.
           ' I have to use 213 instead of 146 for reasons I don't understand--
           ' probably has to do with encoding on Mac, but anyway, this shows the change.
           Selection.Characters(pos + 1) = Chr(213)
        End If
    Next pos
End Sub

Answer 4

也许这个？

Sub FixNumQuotes()
    Dim MyArr As Variant, MyString As String, X As Long, Z As Long
    Debug.Print "starting " + CStr(Now)
    For Z = 145 To 146
        MyArr = Split(Selection.Text, Chr(Z))
        For X = LBound(MyArr) To UBound(MyArr)
            If IsNumeric(Left(MyArr(X), 1)) Then MyArr(X) = "'" & MyArr(X)
        Next
        MyString = Join(MyArr, Chr(Z))
        Selection.Text = MyString
    Next
    Selection.Text = Replace(Replace(Selection.Text, Chr(146) & "'", "'"), Chr(145) & "'", "'")
    Debug.Print "ending " + CStr(Now)
End Sub

我不是100％肯定你的标准，我已经制作了一个开放和单一的单引号a＆＃39;但如果你愿意，你可以很容易地改变它。

它将字符串拆分为chr（145）上的数组，检查每个元素的第一个字符是否为数字，如果找到则用单引号作为前缀。

然后它将数组连接回chr（145）上的字符串，然后为chr重复整个事情（146）。最后，它通过字符串查看单个引号的出现以及彼此相邻的那些卷曲引号中的任何一个（因为这必须是我们刚刚创建的内容）并用我们想要的单引号替换它们。这样就不会在数字旁边发生任何事件。

如果您想要除了＆＃39;之外的其他内容，这个最后的替换部分就是您要改变的部分。作为角色。

Answer 5

我几天来一直在努力解决这个问题。我尝试的解决方案是在document.text上使用正则表达式。然后，使用document.range（start，end）中的匹配项，替换文本。这样可以保留格式。

问题是范围中的开始和结束与索引与文本不匹配。我想我发现了差异 - 隐藏在范围内的是字段代码（在我的例子中它们是超链接）。另外，document.text有一堆很容易剥离的BEL代码。如果使用字符方法遍历某个范围，请将字符附加到字符串并打印它，您将看到如果使用.text方法则不会显示的字段代码。

令人惊讶的是，如果你打开＆＃34;显示字段代码＆＃34;你可以在document.text中获取字段代码。以多种方式之一。不幸的是，该版本与范围/字符显示的不完全相同 - document.text只包含字段代码，范围/字符包含字段代码和字段值。因此，您永远无法获得匹配的字符索引。

我有一个工作版本，而不是使用范围（开始，结束），我做了类似的事情：

Set matchRange = doc.Range.Characters(myMatches(j).FirstIndex + 1)           
matchRange.Collapse (wdCollapseStart)
Call matchRange.MoveEnd(WdUnits.wdCharacter, myMatches(j).Length)
matchRange.text = Replacement

正如我所说，这是有效的，但第一个语句非常慢 - 似乎Word正在遍历所有字符以达到正确的点。这样做，它似乎没有计算字段代码，所以我们得到正确的点。

最重要的是，我无法想出一个很好的方法来匹配document.text字符串到同等范围（开始，结束）的索引，这不是性能灾难。

欢迎提示，谢谢。

Word VBA：迭代字符非常慢

5 个答案: