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

Posted 2023-04-19

【中文标题】使用数组 VBA 查找和替换数据库中的值

【英文标题】：find and replace values in database using an array VBA

【发布时间】：2017-02-03 15:56:17

【问题描述】：

我有一个脏数据库，其中每个人的姓名以不同的方式写入，我无法将它们分组。

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

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

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

【问题讨论】：

你不明白什么？你试过运行它吗？它应该做什么或不应该做什么？

这段代码中没有关于数据库的任何内容。你是说excel表格吗？

请阅读How to Ask并相应地编辑您的问题以获得最有效的帮助。阅读这可能有助于您理解，正如所写的那样，这个问题几乎不可能以任何有意义的方式回答。

对不起，如果问题解释得不好：我对此很陌生。我刚刚编辑了我之前的消息并更新了代码，它仍然无法正常工作。当 for 循环开始时会出现错误。我实际上只需要它遍历一个范围，而不是整个工作表。 Cody G，你说得对，它不是数据库，只是一个电子表格

它是一个范围还是一个 Excel 表格，因为代码引用了一个表格（Excel 中的 listobject 说话）？编辑 - 对不起，我认为误解了。您想根据两列表中的值替换某个范围内的值吗？

【参考方案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

希望这会有所帮助， 丝绸代码

【讨论】：

使用 Option Explicit 总是一个好主意 - 但是，您在代码或链接中都没有显示对此的引用:(

嗨@ScottHoltzman，在模块顶部键入“Option Explicit”以启用它...在此处查看链接：How do I force VBA/Access to require variables to be defined?

【参考方案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

希望这会有所帮助， 丝绸代码

【参考方案3】：

对 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 编辑器的属性中设置项目中工作表的名称或使用默认名称/和或路径。