使用数组VBA查找并replace数据库中的值

我有一个肮脏的数据库，每个人的名字是用不同的方式写的，我不能将它们分组。

我想创build一个macros来查找和replace数据库中的名称使用两列列表。

我find了下面的代码，但是我很难理解它，所以不能适应它：

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

所以要回答你的第二个问题，基本上你需要做的是去除表单循环（你已经完成了），然后你缺less的部分是你还需要指定你想要代码执行replace只是在目标范围内的单元格，而不是在单元格内的单元格（这将是所有的单元格）执行它…看下面的例子：

 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

我已经调整了你的代码，你可以在下面看到。 情侣笔记：

1-使用选项Explicit总是一个好主意2-如果你把数组循环放在表单循环中，你只需要执行表单名检查n次（n =工作表中的表单数），如果你把表单循环在数组循环中，你将不得不执行表名检查n * x次（x =数组中的项目数）… 3 – 你没有指定，但我认为你的Table1是垂直结构化的，查找第一列中的值和第二列中的replace值 – 所以不需要转置你的数组; 如果你的Table1实际上是水平的，那么你需要调整这个代码…

 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，这是一个非常好的答案，它完美地循环通过工作表。

我现在正在尝试适应它，以便它只能在一个范围内循环，不幸的是它不工作。 可能我需要定义一个variables。 我已经在范围之上添加了：

 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