Question

我正在尝试编写一个宏，该宏将自动验证两个文档中存在的表单是否相同。

为此，我需要搜索一个文档并创建一个数组，该数组是该文档中所有表单的列表。每种形式均由唯一的代码（例如AB001或E363）指定。我目前正在搜索这些术语并使用我公然从互联网上偷走的这段代码突出显示它们。

    Dim word As Range
    Dim wordcollection(9) As String
    Dim words As Variant

    'Define list.
    'If you add or delete, change value above in Dim statement.
    wordcollection(0) = "PJ"
    wordcollection(1) = "E1233"
    wordcollection(2) = "E048"
    wordcollection(3) = "E144"
    wordcollection(4) = "E849"
    wordcollection(5) = "E977"
    wordcollection(6) = "IL0021"
    wordcollection(7) = "MISC001"
    wordcollection(8) = "CG0001"
    wordcollection(9) = "CG2107"


    'Set highlight color.
    Options.DefaultHighlightColorIndex = wdYellow

    'Clear existing formatting and settings in Find feature.
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting

    'Set highlight to replace setting.
    Selection.Find.Replacement.Highlight = True

    'Cycle through document and find words in collection.
    'Highlight words when found.
    For Each word In ActiveDocument.words
        For Each words In wordcollection
            With Selection.Find
                .Text = words
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = True
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Find.Execute Replace:=wdReplaceAll
        Next
    Next

End Sub

我需要弄清楚如何将文档中出现的值复制到新数组

然后，我需要在另一个文档中搜索相同的值，并将那个文档中存在的值复制到另一个新数组

最后，我需要比较两个新数组并打印新数组A中存在的值列表，而不是新数组b中存在的值，反之亦然。

任何帮助将不胜感激。我在VBA方面的经验是编写宏以将表单域中的数据自动复制到新表单域，因此即使是对如何执行此操作的基本了解也将不胜感激。

谢谢！

Answer 1

在现有代码中执行ReplaceAll不会给您任何运行时反馈。您必须隔离Found变量，然后才能确定要执行的操作。我的建议是将单个宏分为两个部分，第二个宏提供找到代码的反馈，以便您可以采取措施。

为了向您提供我要描述的示例，下面是一个示例，输出是单独的文本文件，显示每个文档中存在的代码。希望您可以对此进行调整以满足您的要求。

Sub FindCodes()
Dim doc As word.Document
Dim i As Long, wrkFolder As String, fName As String
Dim oFile As String, FileNum As Integer
Dim Codes(0 To 2) As String

Codes(0) = "PJ"
Codes(1) = "E1233"
Codes(2) = "E048"

On Error GoTo errHandler
wrkFolder = "c:\users\<your id>\documents\test\"
fName = Dir(wrkFolder & "*.docx", vbNormal)
Do While fName <> vbNullString
    Set doc = Documents.Open(wrkFolder & fName)
    oFile = Left(doc.FullName, InStrRev(doc.FullName, ".") - 1) & "_Codes.txt"
    On Error Resume Next
    Kill oFile
    On Error GoTo errHandler
    FileNum = FreeFile()
    Open oFile For Append As #FileNum
    Print #FileNum, doc.Name
    For i = 0 To UBound(Codes)
        If Not CheckDocument(doc, Codes(i)) = vbNullString Then
            'the code was found in the document
            'print it in a text file
            Print #FileNum, Codes(i)
        End If
    Next
    Close #FileNum
    doc.Save
    doc.Close
    fName = Dir()
Loop
errHandler:
If Err.Number <> 0 Then
    MsgBox Err.Description, vbExclamation, "Find Codes"
    Err.Clear
End If
End Sub

Private Function CheckDocument(ByRef doc As word.Document, StrCode As String) As String
Dim rng As word.Range
For Each rng In doc.StoryRanges
    'will search headers, footers and the document body
    With rng.Find
        .ClearFormatting
        .Format = True
        .Forward = True
        .MatchCase = True
        .MatchWholeWord = True
        .Text = StrCode
        .Wrap = wdFindStop
        .Execute
        If .Found Then
            'this will highlight the first code found and then exit
            'does it really need to highlight all places the code
            'was found? If so, comment out this IF statement and
            'use the loop method instead
            rng.HighlightColorIndex = wdYellow
            CheckDocument = .Text
            Exit Function
        End If
'            Do While .Found
'                rng.HighlightColorIndex = wdYellow
'                CheckDocument = .Text
'            Loop
    End With
Next
End Function

编写Word宏以比较两个单独文档中的值

1 个答案: