Excel VBA使用其他表中的查找/替换来更新单元格

Question

嘿，我的sheet1包含A列中的搜索模式列表，而列B则包含相应的类别名称列表。我有一个sheet2，其中包含我的银行交易的各种描述列表。

例如，在工作表1中，我有杂货，燃料，娱乐，储蓄，在工作表2中，我有“ Shell服务站，abc路”，“ Coles超市”等。

我想在“交易”列中找到单词，然后将找到的行替换为类别。

例如。 如果我在Sheet2中找到单词“ Shell”，我想用单词“ Fuel”替换该行。

到目前为止，我已经完成了这项工作，但是我不认为这是最有效的方法。 下面是我的代码。

Sub UpdateCats()
Dim x As Integer
Dim FindString As String
Dim ReplaceString As String
Dim NumRows As Integer
'Replace and update Categories
With Sheets("Categories")
    .Activate
  ' Set numrows = number of rows of data.
  NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
  ' Select cell a1.
  Range("A2").Select
  ' Establish "For" loop to loop "numrows" number of times.
  For x = 1 To NumRows
     FindString = ActiveCell.Value
     ActiveCell.Offset(0, 1).Select
     ReplaceString = ActiveCell.Value
     ActiveCell.Offset(1, -1).Select

     With Sheets("Data")
        .Activate
        'With Columns(2)
        Cells.Replace What:=FindString, Replacement:=ReplaceString, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
        'End With
     End With
     Sheets("Categories").Activate
  Next
End With
End Sub

到目前为止，我不喜欢我的代码的原因是因为它必须在运行循环时不断在工作表之间切换（激活）。 有办法更好地做到这一点吗？

Answer 1

总的来说，我不认为这是一个很好的方法。 使用“ ActiveCell”和“ .Activate”是一个非常危险的习惯，因为任何更改都将破坏您的整个代码。 尝试使用命名层次结构（名称应用程序-名称工作簿-名称表-动态范围，例如尽可能多的命名范围）。 我个人也不喜欢偏移函数，我不知道为什么每个人都对它如此着迷，修改这种类型的代码是不透明的，您很少真正需要它。 您可以将整个内容加载到字符串数组中并循环遍历。 它简短且易于阅读。

Answer 2

使用这段代码：

Application.ScreenUpdating=false

Answer 3

这将大大改善处理时间。

Sub UpdateCats()
    Dim v As Long, vFSRSs As Variant

    On Error GoTo bm_Safe_Exit
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    'Replace and update Categories
    With Sheets("Categories")
        vFSRSs = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value2
    End With

    With Sheets("Data")
        With .Columns(2)
            For v = LBound(vFSRSs, 1) To UBound(vFSRSs, 1)
                'Debug.Print vFSRSs(v, 1) & " to " & vFSRSs(v, 2)
                .Replace What:=vFSRSs(v, 1), Replacement:=vFSRSs(v, 2), _
                         LookAt:=xlWhole, MatchCase:=False
            Next v
         End With
    End With

bm_Safe_Exit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

通过将搜索项和替换项存储在二维数组中，遍历工作表单元格的循环将被丢弃。 此外，避免了任何形式的Worksheet.Activate方法或range .Select 。

有关摆脱依赖于选择和激活来实现目标的更多方法，请参见如何避免在Excel VBA宏中使用“选择” 。

Answer 4

我会使用内置的应用程序功能来为您带来好处。 在我的代码中，我已经实现了“ TypeName”和“ Search”方法，它们实际上执行与Ctrl + F和Ctrl + replace相同的操作，只是变得更具可读性。 我认为重要的是要牢记VBA方法的功能强大，并在诉诸更非传统的方法之前先使用它们。

Sub Cats()

With ThisWorkbook
For i = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

    Dim lookupvalue As String

    lookupvalue = Sheets(1).Cells(i, 1).Value

    For n = 1 To Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row

        If TypeName(Application.Search(lookupvalue, Sheets(2).Cells(n, 1))) = "Double" Then
                Sheets(2).Cells(n, 1).Value = Sheets(1).Cells(i, 2).Value
                GoTo exitloop
        End If
    Next n
exitloop:
Next i

End With

End Sub