Question

我有一个脏数据库，每个人的名字都以不同的方式写，我无法对它们进行分组。

我想创建一个宏来使用两列列表查找和替换数据库中的名称。

我找到了以下代码，但我无法理解它，因此无法适应它：

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

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

1-使用Option Explicit总是一个好主意 2-如果将数组循环放在工作表循环中，则只需执行n次工作表名称检查（n =工作簿中的工作表数），如果将工作表循环放入数组循环中，则必须执行工作表名称检查n * x次（x =数组中的项目数）... 3-您没有指定，但我假设您的Table1是垂直构造的，第一列中的查找值和第二列中的替换值 - 因此不需要转置您的数组;如果您的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 2

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

Answer 3

所以要回答你的第二个问题，基本上你需要做的是删除表单循环（你已经完成），然后你缺少的部分是你还需要指定你希望代码执行仅替换目标范围内的单元格，而不是在工作表内的单元格上执行它（这将是所有单元格）...请参阅下面的示例：

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 4

通过稍微调整TheSilkCode代码，您可以如下循环浏览工作表：

Option Explicit

Public Sub pDemo()
    Dim vMappingTable() As Variant
    Dim rowCounter As Long

    '1) Create an Array out of the Old to New Name mapping
    vMappingTable = wksMappings.ListObjects("tbl_Mapping").DataBodyRange

    '2) Loops through desired sheet and replaces any cells that contain the first column val, with the 2nd column val...
    With wksToReplace.Range("X:X")
        For rowCounter = LBound(vMappingTable, 1) To UBound(vMappingTable, 1)
            .Cells.Replace What:=vMappingTable(rowCounter, 1), Replacement:=vMappingTable(rowCounter, 2), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Next
    End With

End Sub

注意：您可以通过名称管理器（Ctrl + F3）定义表的名称，并且可以在VBA编辑器的属性中设置项目中工作表的名称（我在此处完成此操作）或使用默认名称/和或路径。

使用数组VBA查找和替换数据库中的值

4 个答案: