在Word中使用VBA标记文档中的特殊字符

Question

我完全不知道如何更好地处理这个过程。

下面的宏分析文档中的每个字符，如果ASCII值高于255，它会对其应用特殊的字符样式——有些是针对特定语言的，如果不是这些语言的一部分，则只使用“lang”。

宏工作正常，但是在长文档上，处理它需要很长时间。例如，我刚刚处理了一个147页（单行间距）的文档，每页上有几行希腊文，用了40分钟，在Windows的Word 2016中（相比之下，在Mac上完全相同的文件和代码用了2分钟）。

我可以对下面的代码做些什么来优化Windows？

谢谢你的建议。约翰

    Sub CheckSpecialCharacters()
    'This macro looks for any characters above 255 and tags them with the appropriate existing language character.

        Dim ch As Range: Set ch = ActiveDocument.Characters(1)

        Do

            Counter = Counter + 1

            ch.Select

            myValue = AscW(Selection.Text)
            If myValue > 255 Then

                If (myValue > 8190 And myValue < 8225) Or (myValue > 288 And myValue < 381) Or (myValue > 701 And myValue < 704) Or myValue = 730 Then
                    'Ignores Curly Quotes and Transliteration punctuation

                ElseIf (myValue > 7935 And myValue < 8192) Or (myValue > 879 And myValue < 1024) Then
                    'Greek Characters get langgrk applied
                    Selection.Expand unit:=wdWord
                    Selection.Style = "langgrk"

                ElseIf (myValue > 1423 And myValue < 1535) Then
                    'Hebrew Characters get langheb applied
                    Selection.Expand unit:=wdWord
                    Selection.Style = "langheb"

                ElseIf myValue > 7679 And myValue < 7830 Then
                    'Extended transliteration characters get langtrans applied //OLD VALUES// (myValue > 288 And myValue < 381) Or (myValue > 701 And myValue < 704)
                    If HCCP = True Then Selection.Expand unit:=wdWord
                    Selection.Style = "langtrans"

                ElseIf (myValue > 19968 And myValue < 40959) Then
                    'Chinese Characters get langchin applied
                    Selection.Expand unit:=wdWord
                    Selection.Style = "langchin"

                ElseIf (myValue > 19968 And myValue < 40917) Then
                    'Japanese Characters get langjap applied
                    Selection.Expand unit:=wdWord
                    Selection.Style = "langjap"

                Else
                    If HCCP = True Then Selection.Expand unit:=wdWord
                    Selection.Style = "lang"

                End If

            End If

DoNext:


End Sub

Answer 1

由于某种原因，范围。DetectLanguage在我的Word（2007）版本中似乎不起作用，但这可能是需要研究的内容，而不是检查字符代码。

加快Office VBA宏速度的一般方法是禁用屏幕更新：

Application.ScreenUpdating = False
' some slow code that causes the screen to be updated
Application.ScreenUpdating = True 

这对您的情况应该有点帮助，因为您使用的是较慢的选择，而不是范围。

此外，直接检查字节值似乎比AscW快一点：

Sub test()
    'Options.DefaultHighlightColorIndex = wdNoHighlight
    'Range.HighlightColorIndex = wdNoHighlight ' used for testing to clear Highlight

    Dim r As Range, t As Double: t = Timer
    Application.ScreenUpdating = False

    For Each r In Range.Characters ' For Each r In Range.Words is somehow about 2 times slower than .Characters
        checkRange r
    Next

    Application.ScreenUpdating = True
    Debug.Print Timer - t; Range.Words.Count; Range.Characters.Count; Range.End ' " 3.15625  8801  20601  20601 "
End Sub

Sub checkRange(r As Range)
    Dim b() As Byte, i As Long, a As Long
    b = r.Text ' converts the string to byte array (2 or 4 bytes per character)
    'Debug.Print "'" & r & "'"; r.LanguageID; r.LanguageIDFarEast; r.LanguageIDOther

    For i = 1 To UBound(b) Step 2            ' 2 bytes per Unicode codepoint
        If b(i) > 0 Then                     ' if AscW > 255
            a = b(i): a = a * 256 + b(i - 1) ' AscW
            Select Case a
                Case &H1F00 To &H1FFF: r.HighlightColorIndex = wdBlue: Exit Sub ' Greek Extended
                Case &H3040 To &H30FF: r.HighlightColorIndex = wdPink: Exit Sub ' Hiragana and Katakana
                Case &H4E00 To 40959: r.HighlightColorIndex = wdGreen: Exit Sub ' CJK Unified Ideographs

                Case 55296 To 56319: ' ignore leading High Surrogates ?
                Case 56320 To 57343: ' ignore trailing Low Surrogates ?

                Case Else: r.HighlightColorIndex = wdRed: Debug.Print Hex(a), r.End - r.Start ' other
            End Select
        End If
    Next
End Sub

代码中的一些Unicode代码点（如8190）似乎有点不对劲，因此您可以在http://www.fileformat.info/info/unicode/block/index.htm