配列を使用してデータベースの値を検索して置き換えます。

Question

私は、各個人の名前が異なる方法で書かれていて、それらをグループ化できない、汚れたデータベースを持っています。

2つの列リストを使用して、データベース内の名前を検索して置き換えるマクロを作成したいとします。

私は、次のコードを発見したが、 - 私は悩み、それを理解したので、それを適応させることはできません。

Dim Sht As Worksheet 
Dim fndList As Integer 
Dim rplcList As Integer 
Dim tbl As ListObject 
Dim myArray As Variant 
Dim Rng As Range 


'Create variable to point to your table 
    Set tbl = Worksheets("How to").ListObjects("Table2") 

'Create an Array out of the Table's Data 
    Set TempArray = tbl.DataBodyRange 
    myArray = Application.Transpose(TempArray) 

'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, 2) 
    'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it) 
     For Each Rng In Worksheets("xxxxxxxxxx").Activate 
     If Rng.Name <> tbl.Parent.Name Then 

      Rng.Cells.replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _ 
      LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ 
      SearchFormat:=False, ReplaceFormat:=False 

     End If 
     Next Rng 

    Next x 

End Sub 

Answer 1

ので、基本的にあなたがする必要があるだろうか（あなたが行っている）シートのループを削除しているあなたの2番目の質問に答えるために、そしてあなたが欠けている部分がありますシート内のセル（すべてのセル）上で実行するのではなく、ターゲット範囲内のセルだけでコードを置換するように指定する必要があります。

このことができます

Public Sub demoCode_v2() 
Dim tableRange As Range 
Dim myArray() As Variant 
Dim rowCounter As Long 
Dim targetRange As Range 

'Create an Array out of the Table's Data 
Set tableRange = ThisWorkbook.Sheets(sheetName).ListObjects("Table1").DataBodyRange 
myArray = tableRange 

'Select target range 
Set targetRange = Application.InputBox("Select target range:", Type:=8) 

'Loop through each item in lookup table 
For rowCounter = LBound(myArray, 1) To UBound(myArray, 1) 
    'Replace any cells in target range that contain whats in the first column of the lookup table, with whats in the 2nd column.. 
    targetRange.Cells.Replace What:=myArray(rowCounter, 1), Replacement:=myArray(rowCounter, 2), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 
Next 

End Sub 

希望、 TheSilkCode

Answer 2

私はあなたが以下を参照することができ、あなたのコードを調整しています。あなたがシートループ内に配列ループを置く場合は、シート名のチェックをn回実行するだけです（n =ブック内のシート数）、シートループを配列ループ内に置くと、n * x回のシート名チェック（x =配列内の項目数）を実行する必要があります。 3指定しませんでしたが、 Table1は最初の列のルックアップ値と2番目の置換値で垂直方向に構成されていたので、配列を転置する必要はありません。あなたの表1は、実際にある場合は、水平、あなたはそれがをループに完璧に動作し、それは非常に良い答えだった、このことができます

Public Sub demoCode() 
Dim sheetName As String 
Dim tableRange As Range 
Dim myArray() As Variant 
Dim wsCounter As Long 
Dim rowCounter As Long 

'Store name of sheet with lookup table 
sheetName = "How to" 

'Create an Array out of the Table's Data 
Set tableRange = ThisWorkbook.Sheets(sheetName).ListObjects("Table1").DataBodyRange 
myArray = tableRange 

'Loop through each sheet 
For wsCounter = 1 To ThisWorkbook.Sheets.Count 
    With ThisWorkbook.Sheets(wsCounter) 
     'Test to make sure the sheet is not the sheet with the lookup table 
     If .Name <> sheetName Then 
      'Loop through each item in lookup table 
      For rowCounter = LBound(myArray, 1) To UBound(myArray, 1) 
       'Replace any cells that contain whats in the first column of the lookup table, with whats in the 2nd column.. 
       .Cells.Replace What:=myArray(rowCounter, 1), Replacement:=myArray(rowCounter, 2), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 
      Next 
     End If 
    End With 
Next 

End Sub 

希望、 TheSilkCode

Answer 3

TheSilkCode ...このコードを調整する必要がありますそのシート。

私はそれを適応させようとしています。残念ながら、その範囲をループするだけです。おそらく私は変数を定義する必要があります。私は範囲としてRNGの上にすでに追加：

Option Explicit 

Public Sub demoCode() 
Dim sheetName As String 
Dim tableRange As Range 
Dim myArray() As Variant 
Dim wsCounter As Long 
Dim rowCounter As Long 
Dim Rng As Range 

'Store name of sheet with lookup table 
sheetName = "How to" 

'Create an Array out of the Table's Data 
Set tableRange = ThisWorkbook.Sheets(sheetName).ListObjects("Table2").DataBodyRange 
myArray = tableRange 

'Loop through range in Worksheet  
Worksheets("Post").Activate 
Range("ak1").Select 
Selection.End(xlDown).Select 

For Each Rng In Selection 

    'Loop through each item in lookup table 
     For rowCounter = LBound(myArray, 1) To UBound(myArray, 1) 
    'Replace any cells that contain whats in the first column of the lookup  table, with whats in the 2nd column.. 
    .Cells.Replace What:=myArray(rowCounter, 1), Replacement:=myArray(rowCounter, 2), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 
Next 


End Sub