在vba中查找关键词列表并替换它们。

Question

我是新来的，所以请原谅任何形式上的失误。

我目前正在尝试使用一个宏来查找和替换Word文档中的多个关键字（我已经用一个独特的开头和结尾标记以帮助程序使用通配符查找它们），并将它们替换为Excel中列表中的另一个单词。

我的代码使用Selection.Find.Execute()，可以工作，但速度非常慢，甚至容易崩溃。我想知道是否有任何方法可以搜索这些词ONCE（关键字的例子；çbeginçKEYWORDçendç），如 "Find(çbeginç*çendç)"，然后比较和替换ONLY这些发现。

我的想法是

Find(çbeginç*çendç) --> array_of_instances, array_of_positions。

然后，有了这两个数组，我就可以将array_of_instances与我的替换列表进行比较，然后进入文档，到 "array_of_positions "中的所需位置进行修改。

作为参考，我使用了与这些类似的代码（但使用的是wordApp.Selection.Find对象）。https:/superuser.comquestions1317223replace-in-ms-word-with-cell-value-in-excel-vba。character as delimiters:

Note that every entry in the Find list (FList) must have a corresponding entry in the Replace list (RList) - even if empty.

Answer 1

Sub BulkFindReplace()
Application.ScreenUpdating = False
Dim FList As String, RList As String, j As Long
FList = "FndStrA|FndStrB|FndStrC|FndStrD|FndStrE"
RList = "RepStrA|RepStrB|RepStrC|RepStrD|RepStrE"
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = False
  .Forward = True
  .Wrap = wdFindContinue
  .MatchWildcards = True
   'Process each word from the Find/Replace Lists
  For j = 0 To UBound(Split(FList, "|"))
    .Text = Split(FList, ",")(j)
    .Replacement.Text = Split(RList, "|")(j)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub

我是新来的，所以请原谅任何形式上的失误。我目前正在尝试在一个Word文档中查找和替换多个关键词（我已经用一个混乱的开头和结尾标记 ...

如果只是一个小的列表，你可以在Word中简单地完成，而不涉及Excel。例如，使用Replace表达式，在每个表达式之间加一个tab，然后写上类似的代码。

Sub BulkFindReplace()
Application.ScreenUpdating = False
Dim FRDoc As Document, FRList, j As Long, StrFnd As String, StrRep As String
 'Load the strings from the reference doc into a text string to be used as an array.
Set FRDoc = Documents.Open("C:\Users\" & Environ("Username") & "\Documents\FindReplaceList.doc")
FRList = FRDoc.Range.Text
FRDoc.Close False
Set FRDoc = Nothing
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Wrap = wdFindContinue
  .MatchWildcards = True
   'Process each word from the Check List. Tab-delimited strings are assumed, formatted as:
   'Find text <Tab> Replace text
  For j = 0 To UBound(Split(FRList, vbCr)) - 1
    StrFnd = Split(Split(FRList, vbCr)(j), vbTab)(0)
    StrRep = Split(Split(FRList, vbCr)(j), vbTab)(1)
    .Text = StrFnd
    .Replacement.Text = StrFnd & vbCr & StrRep
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub

还有一种方法是在另一个文档中使用一个表格，参见： 如何防止Word在使用批量查找和替换宏时崩溃？

但是，如果你真的需要want使用Excel工作簿。

Sub BulkFindReplace()
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim iDataRow As Long, i As Long, xlFList As String, xlRList As String
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\FindReplaceList.xlsx"
StrWkSht = "Sheet1" 'The name of the worksheet holding the F/R list.
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
On Error Resume Next
'Start Excel
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
  MsgBox "Can't start Excel.", vbExclamation
  Exit Sub
End If
On Error GoTo 0
With xlApp
  'Hide our Excel session
  .Visible = False
  ' The file is available, so open it.
  Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, ReadOnly:=True, AddToMru:=False)
  If xlWkBk Is Nothing Then
    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
    .Quit
    Exit Sub
  End If
  ' Process the workbook.
  With xlWkBk
    'Ensure the worksheet exists
    If SheetExists(StrWkSht) = True Then
      With .Worksheets(StrWkSht)
        ' Find the last-used row in column A.
        iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
        ' Capture the F/R data.
        For i = 1 To iDataRow
          ' Skip over empty fields to preserve the underlying cell contents.
          If Trim(.Range("A" & i)) <> vbNullString Then
            xlFList = xlFList & "|" & Trim(.Range("A" & i))
            xlRList = xlRList & "|" & Trim(.Range("B" & i))
          End If
        Next
      End With
    Else
      MsgBox "Cannot find the designated worksheet: " & StrWkSht, vbExclamation
    End If
  .Close False
  End With
  .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Exit if there are no data
If xlFList = "" Then Exit Sub
'Process each word from the F/R List
For i = 1 To UBound(Split(xlFList, "|"))
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Foward = True
      .Format = False
      .Wrap = wdFindContinue
      .MatchWildcards = True
      .Text = Split(xlFList, "|")(i)
      .Replacement.Text = Split(xlRList, "|")(i)
      .Execute Replace:=wdReplaceAll
    End With
  End With
Next
Application.ScreenUpdating = True
End Sub

上述每一种方法都只处理活动文档中的正文内容。要想把页眉、页脚等内容也处理掉，请看。https:/www.msofficeforums.comword-vba29777-multi-doc-find-replace-including-headers-footers.html 的一些代码。

要处理多个文件，请参见，例如。https:/www.msofficeforums.com70404-post4.html 和 https:/www.msofficeforums.com70765-post10.html