从 Excel 列表中“查找和替换”Word 中的多个单词

Posted 2023-03-11

【中文标题】从 Excel 列表中“查找和替换”Word 中的多个单词

【英文标题】："Find and Replace" multiple words in Word from Excel list

【发布时间】：2014-06-17 23:35:05

【问题描述】：

我在 MS Word 中创建了一个查找和替换宏，将单词 A 替换为 B。好的，但现在我有 50 个单词需要替换。这意味着我必须为每个单词创建一个新条目，这将永远持续下去。再加上几周后，我将不得不添加更多要替换的单词。

有没有办法通过 excel 链接单词列表，说第 1 列中的单词是我想用第 2 列中的匹配单词替换的单词？

这是我目前所拥有的。

Sub Macro5()
'
' Macro5 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "apples"
        .Replacement.Text = "all the apples"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute
End Sub

【问题讨论】：

psst.... 代码块需要缩进 4 个空格才能显示出来。

@Birk 如果您愿意，请给我发送电子邮件：dzemens [at] gmail.com

【参考方案1】：

修改您的宏，使其可以accept parameters 用于“word 查找”和“要替换的单词”。 Loop through a range 在 Excel 中， 通过value of each cell 到您修改后的宏（子程序）。

【参考方案2】：

这样的事情应该可以帮助您入门。将 Excel 绑定到 Word，打开包含列表的文件，然后遍历列表，依次调用您的宏（修改为接受两个字符串参数，findText 和 replaceText）。

Sub Main()
Dim xl as Object 'Excel.Application
Dim wb as Object 'Excel.Workbook
Dim ws as Object 'Excel.Worksheet
Dim rng as Object 'Excel.Range
Dim cl as Object  'Excel.Range
Set xl = CreateObject("Excel.Application")
Set wb = xl.Workbooks.Open("c:\folder\file.xlsx") '## Modify as needed
Set ws = wb.Sheets(1) '##Modify as needed
Set rng = ws.Range("A1", ws.Range("A1").End(xlDown))
For each cl in rng
    Call Macro5(cl.Value, cl.offset(0,1).Value)
Next
End Sub

您需要自己确认Macro5 的内容在上述循环中按预期工作。

Sub Macro5(findText$, replaceText$)
'
' Macro5 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = findText
        .Replacement.Text = replaceText
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute
End Sub