【问题标题】:Find/replace macro for multiple worksheets查找/替换多个工作表的宏
【发布时间】:2016-06-23 04:50:17
【问题描述】:

我正在使用位于 The Spreadsheet Guru 的多个查找/替换宏,但遇到了问题。我有一个包含多个工作簿的电子表格,其中包含姓名和轮班,我需要通过使用另一个工作表中的表格附加资格来更新姓名:

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

我需要“LookAt:=x1Part”,因为名称有时会在末尾包含其他信息(例如班次长度等)。在我看来,下面的代码应该逐步遍历每个工作表,但它似乎为它查看的每个工作表运行整个工作簿的查找/替换。 IE。如果有 3 个工作表,“Smith”将变为“Smith (123) (123) (123)”

有什么办法可以防止这种情况发生吗?查找/替换宏是否最适合此目的?

    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

【问题讨论】:

  • 看起来这里可能存在某种其他问题 - 代码实际上并没有忽略 Sheet1,而是对我用于查找/替换宏的表进行了更改,这可以解释重复的限定条件.

标签: vba excel


【解决方案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

我只有多次运行才能得到你显示的结果...

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2018-04-11
    • 1970-01-01
    • 1970-01-01
    • 2017-02-01
    • 2011-03-28
    • 1970-01-01
    • 1970-01-01
    • 2020-03-22
    相关资源
    最近更新 更多