查找/replace多个工作表的macros

我正在使用在Spreadsheet Guru上find的多个查找/replacemacros，并且遇到了问题。 我有一个包含名称和名单轮class的多个工作簿的电子表格，而且我需要通过在另一个工作表EG中附加资格来更新名称：

A1 Name Replace A2 Smith Smith (123) A3 Jones Jones (ABC) 

我需要“LookAt：= x1Part”，因为名字有时会在结尾处有其他信息（比如移位长度等）。 它看起来像下面的代码应该逐步通过每个工作表，但它似乎运行整个工作簿查找每个工作表的查找/replace。 即。 如果有3张工作表，“史密斯”将成为“史密斯（123）（123）（123）”

有什么办法可以防止这种情况发生？ 查找/replacemacros是否最适合此目的？

  Sub Multi_FindReplace() 'PURPOSE: Find & Replace a list of text/values throughout entire workbook from a table 'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault Dim sht As Worksheet Dim thing As Worksheet Dim fndList As Integer Dim rplcList As Integer Dim tbl As ListObject Dim myArray As Variant 'Create variable to point to your table Set tbl = Worksheets("Sheet1").ListObjects("Table1") 'Create an Array out of the Table's Data Set TempArray = tbl.DataBodyRange myArray = Application.Transpose(TempArray) 'Designate Columns for Find/Replace data fndList = 3 rplcList = 4 'Loop through each item in Array lists For x = LBound(myArray, 1) To UBound(myArray, 2) 'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it) For Each sht In ActiveWorkbook.Worksheets If sht.Name <> tbl.Parent.Name Then sht.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False End If Next sht Next x End Sub 

Answer 1

代码看起来不错，但我更喜欢没有转置操作：

 Public Sub MultiFindReplace() Dim sht As Worksheet Dim fndList As Long, rplcList As Long, x As Long Dim tbl As ListObject Dim myArray As Variant 'Create variable to point to your table Set tbl = Worksheets("Sheet1").ListObjects("Table1") myArray = tbl.DataBodyRange.Value 'Designate Columns for Find/Replace data fndList = 1 rplcList = 2 'Loop through each item in Array lists For x = LBound(myArray, 1) To UBound(myArray, 1) 'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it) For Each sht In ActiveWorkbook.Worksheets If sht.Name <> tbl.Parent.Name Then sht.Cells.Replace What:=myArray(x, fndList), _ Replacement:=myArray(x, rplcList), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False End If Next sht Next x End Sub 

我只能通过多次运行得到您显示的结果…