Question

我正在使用The Spreadsheet Guru处找到的多个查找/替换宏并遇到问题。我有一个包含多个工作簿的电子表格，其中包含名称和名册轮班，我需要通过使用另一个工作表中的表格附加资格来更新名称EG：

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

我需要＆＃39; LookAt：= x1Part＆＃39;因为名称有时会在末尾有其他信息（例如班次长度等）。在我看来，下面的代码应该遍历每个工作表，但它似乎为它看到的每个工作表运行整个工作簿的查找/替换。即。如果有3个工作表，史密斯＆＃39;将成为史密斯（123）（123）（123）＆＃39;

有没有办法阻止这种情况发生？发现/替换宏是否最适合此目的？

    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

代码看起来没问题虽然我更喜欢没有Transpose操作：

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

我只能通过多次运行来显示您显示的结果......

查找/替换多个工作表的宏

1 个答案: