避免代码重复答案

【问题标题】：Avoid code repeat避免代码重复
【发布时间】：2018-06-03 05:24:16
【问题描述】：

我的代码使用 VBA Excel 宏在 Word 文件中搜索单词并将它们粘贴到 Excel 工作表单元格，但我的代码现在多次重复相同的查找功能：

Sub test()
Dim Word As Object
Dim WordDoc As Object
Dim r, f As Boolean, fO As Long
Set Word = CreateObject("Word.Application")
Set WordDoc = Word.Documents.Open(Filename:=Application.ThisWorkbook.path & "\test.docx")
'''Name'''
Set r = WordDoc.Range
Do
With r.Find
    .ClearFormatting
    .Text = "name*author"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    If .Execute Then
                If f Then
                    If r.Start = fO Then
                Exit Do
                    End If
                Else
                    fO = r.Start
                    f = True
                End If
                WordDoc.Range(r.Start + 4, r.End - 6).Copy
                Range("C4").Select
                ActiveSheet.Paste
                Set r = WordDoc.Range(r.End, r.End)
            Else
                Exit Do
            End If
        End With
    Loop
'''Exercise'''
Set r = WordDoc.Range
Do
With r.Find
    .ClearFormatting
    .Text = "exercise*book"
    ...
                WordDoc.Range(r.Start + 8, r.End - 4).Copy
                Range("C6").Select
                ActiveSheet.Paste
                Set r = WordDoc.Range(r.End, r.End)
            Else
                Exit Do
            End If
        End With
    Loop
End Sub

如何避免代码重复？

有人可以帮我解决这些问题吗？提前致谢！

【问题讨论】：

重复复制粘贴同一个函数是什么意思？
正确缩进你的代码，然后第一个循环和第二个循环之间的差异会更加明显，这意味着，如果你想重构那个部分，你需要做一些思考编写正确的辅助函数的所有潜在用例。

标签： vba excel

【解决方案1】：

您可以像这样将重复的代码移动到函数/子中：

Set r = WordDoc.Range
Do While UnifiedSearch (r, "name*author")
    If f Then
        If r.Start = fO Then
            Exit Do
        End If
    Else
        fO = r.Start
        f = True
    End If
    WordDoc.Range(r.Start + 4, r.End - 6).Copy
    Range("C4").Select
    ActiveSheet.Paste
    Set r = WordDoc.Range(r.End, r.End)
Loop
'''Exercise'''
Set r = WordDoc.Range
Do While UnifiedSearch (r, "exercise*book")
    WordDoc.Range(r.Start + 8, r.End - 4).Copy
    Range("C6").Select
    ActiveSheet.Paste
    Set r = WordDoc.Range(r.End, r.End)
Loop
End Sub

Private Function UnifiedSearch(r as Range, s As String) As Boolean

     With r.Find
        .ClearFormatting
        .Text = s
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        UnifiedSearch = .Execute
    End With

End Function

【讨论】：

当我运行代码时，我在这一行得到一个“编译错误：需要对象”：Set r = WordDoc.Range。我需要改变什么？
这一行只是一个指示，告诉你在哪里插入我的 sn-p 到你的代码中。
我明白这一点，但仍然报错。我试图删除这一行中的“Set”，但随后又出现另一个错误：ByRef argument type mismatch
尝试使用有效的搜索起点，例如Set r = WordDoc.Range(0, 0)。注意：您必须 Set 对象的值，例如Range.
Set r = WordDoc.Range(0, 0) 不起作用，仍然给出同样的错误。