使用VB在特定Excel工作表中查找/替换

时间:2017-05-20 12:43:15

标签: excel excel-vba vba

我需要你的帮助,好人。我在网上搜索过,无法找到问题的解决方案。 VB不是我的强项,但由于我被迫使用的真正的后向系统,VB似乎是缩短我的工程时间的答案。我找到了一段可行的代码,但我需要扩展它。

我需要此代码不在每张工作表中搜索和替换,而只需要一张特定的工作表。一旦我做对了,我会修改它以做更多,更多。 :)

那么,我该如何更改此代码呢?

Sub Multi_FindReplace()
'PURPOSE: Find & Replace a list of text/values throughout entire workbook from a table
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant

'Create variable to point to your table
  Set tbl = Worksheets("Table").ListObjects("Table1")

'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 sht In ActiveWorkbook.Worksheets
        If sht.Name <> tbl.Parent.Name Then

          sht.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False

        End If
      Next sht
  Next x

End Sub

这个代码最终还会有更多的结果,但是如果没有金钱奖励给予完整的范围是不公平的。只需这个解决方案即可。 :)

PS:希望格式运行正常吗?

1 个答案:

答案 0 :(得分:0)

试试这个:

Sub Multi_FindReplace() 
Dim sht As Worksheet 
Dim fndList As Integer 
Dim rplcList As Integer 
Dim tbl As ListObject 
Dim myArray As Variant

Set tbl = Worksheets("Table").ListObjects("Table1")
Set TempArray = tbl.DataBodyRange 
Set sht = 'the sheet you want to run through
myArray = Application.Transpose(TempArray)
fndList = 1 rplcList = 2

For x = LBound(myArray, 1) To UBound(myArray, 2) 
      sht.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
        SearchFormat:=False, ReplaceFormat:=False
    End If
Next x
End Sub