WinWord'的VBA仿真；s文件比较字符串

我正在用拼写稍有不同的字符串替换WinWord文档中的某些字符串，并启用修订跟踪

修订跟踪将整个原始字符串标记为删除，整个替换字符串标记为插入。任何查看文本并想知道某个字符串被替换的原因的人都必须对两个字符串进行视觉比较，即使它们仅在一个或两个字符上有所不同

---

我更希望只将不同的字符标记为修订。这可能意味着我必须模拟WinWords文件比较函数，尽管不是针对整个文件，而是针对给定文件中的字符串。有没有人尝试过类似的方法，或者对如何完成这项任务有过好的想法？（我知道，可以将原始字符串和替换字符串复制到两个空文件中，比较文件并使用结果，但对于单个文件中的数百个字符串来说，这不是一个切实可行的解决方案。）

一种方法是在实际替换单词时更具选择性。内置的“查找/替换”通过替换整个单词来工作，但通过使用VBA，您可以更具体地了解要替换的内容。因此，我们仍然使用内置的Find函数来识别要替换的单词，但是您可以遍历单词中的每个字符，并与替换文本进行比较，因此只替换必要的内容。我已经对下面的代码进行了注释，以解释这个示例是如何工作的

这将产生如下示例所示的输出，仅突出显示已更改的实际字符

Sub-replaceDifferencesOnly（）
将findText设置为字符串：findText=“Analyze”
将replaceText设置为字符串：replaceText=“分析”
Dim发现为布尔值：发现=真
'使用内置的'Find'函数，循环遍历
'在文档中查找文本。
发现时
选择。查找
.Text=findText
.Replacement.Text=“”
.Forward=True
.Wrap=wdFindContinue
.Format=False
.MatchCase=True
.MatchWholeWord=True
.MatchWildcards=False
.MatchSoundsLike=False
.MatchAllWordForms=False
以
'如果在文档中找到findText。。。
如果Selection.Find.Execute=True，则
暗匹配范围
暗字符作为范围
尺寸位置为整数：位置=1
'将选择范围转移到单独的范围对象中。
设置匹配=选择范围
对于匹配中的每个字符。字符
选择案例长度（替换文本）
案例>=位置
'如果findText和replaceText当前长度相等。。。
'只需比较和替换不同的字符。
如果不是char.Text=Mid（replaceText，position，1），则
char.InsertBefore Mid（替换文本，位置，1）
'插入字符将扩展当前“字符”或范围的大小
'移动范围的起始位置，以便仅删除原始不需要的字符。
char.MoveStart
删除字符
如果结束
病例<1例
'如果replaceText比findText短。。。
'只需删除findText中剩余的不需要的字符。
字符。删除
结束选择
位置=位置+1
下一个字符
如果位置
Sub replaceDifferencesOnly()

Dim findText As String: findText = "Analyze"
Dim replaceText As String: replaceText = "Analyse"
Dim found As Boolean: found = True

'   Using the built-in 'Find' Function, loop through each instance of
'   findText within the Document.
While found
    With Selection.Find
        .Text = findText
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    '   If findText is found within the Document...
    If Selection.Find.Execute = True Then

        Dim match As Range
        Dim char As Range
        Dim position As Integer: position = 1

        '   Transfer the Selections Range into a seperate Range object.
        Set match = Selection.Range

        For Each char In match.Characters

            Select Case Len(replaceText)

                Case Is >= position
                    '   If findText and replaceText are currently of an equal length...
                    '   Simply compare and replace differing character.

                    If Not char.Text = Mid(replaceText, position, 1) Then
                        char.InsertBefore Mid(replaceText, position, 1)
                        '   Inserting a Character will extend the size of the current 'character' or Range
                        '   Move the start position of the range on so as to only delete the original unwanted character.
                        char.MoveStart
                        char.Delete wdCharacter
                    End If

                Case Is < position
                    '   If replaceText is shorter than findText...
                    '   Simply delete the remaining unwanted characters in findText.
                    char.Delete

            End Select

            position = position + 1

        Next char

        If position <= Len(replaceText) Then
            '   Finally if replaceText is longer than findText ie. we've processed each original character in
            '   findText but there are still more characters in replaceText...
            '   Simply append the remaining characetrs within replaceText to the end of the Range

            match.InsertAfter Mid(replaceText, position, (Len(replaceText) - position) + 1)
        End If

    Else
        '   No match from Find so exit the routine as there is nothing more to replace.
        found = False
    End If
Wend

'   Clear the current Selected text.
Selection.Collapse
End Sub