Question

我有一个包含大约1000个单词对的列表供替换。通过循环遍历形状，我必须一次又一次地遍历单词对。为了让它运行得更快我尝试在执行替换之前选择所有形状，但它没有工作。任何建议将不胜感激。

当前代码的相关部分（对存储在名为key（）的列表和名为oDic的字典中：

With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
End With
shape_num = ActiveDocument.Shapes.count
On Error GoTo errhandler

For i = 1 To shape_num
    If ActiveDocument.Shapes(i).TextFrame.HasText Then
        ActiveDocument.Shapes(i).Select
        For j = 1 To lexicon_num
            SrcText = key(j)
            With Selection.Find
                .Text = SrcText
                .Replacement.Text = oDic.Item(SrcText)
                .Execute Replace:=wdReplaceAll
            End With
        Next j
    End If
    continue_shape:
Next i
exit sub
errhandler:
Err.Clear
Resume continue_shape

Answer 1

请注意，您的具体问题的答案是：不，不能在Word中使用VBA一次性替换形状中的单词（不通过形状循环）

但是，我的印象是，您真正感兴趣的是如何优化代码的更一般的问题。以下是一个解决方案。

我建议在评论中实现Trie，但经过进一步考虑后，我认为内置的Scripting.Dictionary对象足以满足您的需求。

我建议您加载一个Scripting.Dictionary，其中包含您要查找的单词（作为键）并替换（作为值）。您可以循环浏览每个形状的单词并检查Scripting.Dictionary以查看它是否存在。如果是，请更换它;如果没有，请不要管它。

我创建了一个矩形，其中包含“此形状中包含”查找“字样的文字。”其中“查找”用粗体和红色表示。我对它进行了测试，将“find”替换为“replace”，并保留格式。

以下是示例代码：

Public Sub Main()
    Dim dictFindReplace As Scripting.Dictionary

    Set dictFindReplace = New Scripting.Dictionary

    'Add all your words to the dictionary here
    dictFindReplace.Add "find", "replace"

    'Loop through all the shapes
    For i = 1 To ActiveDocument.Shapes.Count

        'If the shape has text
        If ActiveDocument.Shapes(i).TextFrame.HasText Then
            With ActiveDocument.Shapes(i).TextFrame.TextRange.Words
                'Loop through each word. This method preserves formatting.
                For j = 1 To .Count

                    'If a word exists in the dictionary, replace the text of it, but keep the formatting.
                    If dictFindReplace.Exists(.Item(j).Text) Then
                        .Item(j).Text = dictFindReplace.Item(.Item(j).Text)
                    End If
                Next
            End With
        End If
    Next i

End Sub

如何使用VBA一次性替换形状中的单词（不通过形状循环）

1 个答案: