Excel VBA使用查找/replace从另一个工作表更新单元格

嘿，我有一个sheet1，包含A列中的search模式列表，B列中的类别名称列表。我有一个sheet2，它有我的银行交易的各种描述的列表。

例如在表1中我有食品杂货，燃料，娱乐，储蓄，并在sheet2我有“壳牌服务站，abc路”，“科尔斯超市”等。

我想在交易列中find单词，然后用find的类别replacefind的行。

例如。 如果我在Sheet2中find“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”是一个相当危险的习惯，因为无论什么改变都会影响你的整个代码。 尝试使用命名层次结构（名称应用程序 – 名称工作簿 – 名称表 – dynamic范围，如命名范围尽可能）。 我个人也不太喜欢偏移函数，我不知道为什么每个人都这么疯狂，修改这种types的代码是不透明的，你很less真的需要它。 你可以将整个东西加载到一个string数组中并循环。 它简短易读。

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 

通过将search和replace项存储在二维数组中，放弃通过工作表单元的循环。 此外，任何forms的Worksheet.Activate方法或范围.Select已被避免。

请参阅如何避免使用Excel中的selectVBAmacros来获取更多的方法来摆脱依靠select和activate来实现您的目标。

Answer 4

我会使用内置的应用程序function，以利于您。 在我的代码中，我实现了“TypeName”和“Search”方法来实现与Ctrl + F和Ctrl +replace相同的function，只是变得更易读。 我认为重要的是要注意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