複数のワークシートのマクロの検索/置換

Question

私はThe Spreadsheet Guruにある複数の検索/置換マクロで作業しており、問題が発生しました。私は名前と名簿シフトを含む複数のワークブックとスプレッドシートを持っている、と私は別のワークシートEGでテーブルを使用して資格を追加して名前を更新する必要があります。名前は意志のように：

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

私は「= x1Partルックアット」に必要終了時に他の情報があることがあります（シフトの長さなど）。下のコードが各ワークシートをステップ実行する必要があるように見えますが、見ているシートごとにワークブック全体の検索/置換が実行されているようです。すなわち、 3つのワークシートがある場合、「スミス」は「スミス（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 

Answer 1

私は転置操作なしでそれを好むだろうけれども、コードはOKになります。

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 

私はそれを複数回実行することにより、あなたが示した結果を得ることができます...