Question

我正在尝试设置一些代码来自动执行我必须在我运行的每周报告中执行的任务。任务是进入所有数据＆＃39;工作表并进行多次查找和替换，以便报告中涉及数据表的其他部分看起来更清晰。

目前我的代码与此类似：

sub FindReplaceSheets()
  dim nameofsheet as string
  nameofsheet = "ABC Data"
  call FindReplace (nameofsheet)
  nameofsheet = "DEF Data"
  call FindReplace (nameofsheet)
End Sub

sub FindReplace (x)
  Sheets.(x).select
  Cells.Replace What:="qwerty", Replacement:="asdfgh"
  Cells.Replace What:="zxcvb", Replacement:="mnbvc"
  Cells.Replace What:="poiuy", Replacement:="lkjhg"
End Sub

虽然这很好用，但我相信它可以做得更整齐。有比上面列出的更多的工作表和更多的查找/替换，但不是代码的速度是至关重要的，我想让它看起来更整洁，更容易编辑。

我试图通过两种方式对其进行编辑：首先通过For each语句完成工作表选择，但我无法使用

这样的工作

For each ws
 If right(ws.name, 4) = "Data"

其次，我尝试编辑find以使用数组，我在其中定义每个查找和替换字符串，但似乎无法获得正确的语法。

我认为一个字符串数组和一个for循环适合我想要实现的目标，但如果更合适，请告知其他方法。

提前感谢您的帮助。

Answer 1

Sub FindReplaceSheets(sheetNamesArray As Variant, findTextArray As Variant, replaceWithTextArray As Variant)
Dim sheetName

For Each sheetName In sheetNamesArray
    If Right(sheetName, 4) = "data" Then
        Call FindReplace(sheetName, findTextArray, replaceWithTextArray)
    End If
Next
End Sub
Sub FindReplace(ByVal sheetName As String, findTextArray As Variant, replaceWithTextArray As Variant)
Dim i As Integer
Dim count As Integer

count = UBound(findTextArray)
Sheets(sheetName).Select

For i = 0 To count
  Cells.Replace What:=findTextArray(i), Replacement:=replaceWithTextArray(i)
Next
End Sub

以下是您调用上述程序的方法

call FindReplaceSheets(Array("Sheet1Data", "Sheet2Data"), Array("findtext1", "findtext2"), Array("replacetext1", "replacetext2"))

Answer 2

创建一个数组并使用循环：

Sub FindReplaceSheets()
   ary = Split("ABC Data,DEF Data", ",")

   For Each a In ary
      Call FindReplace(a)
   Next a
End Sub

Answer 3

Option Explicit

Public Sub cleanUpData()

    Dim i As Long, ws As Worksheet, dataWS As String
    Dim oldTxt      As Variant
    Dim newTxt      As Variant
    Dim firstItm    As Long
    Dim lastItm     As Long

    dataWS = " Data"

    oldTxt = Array("aaa", "bbb", "ccc")
    newTxt = Array("xxx", "yyy", "zzz")

    firstItm = LBound(oldTxt)
    lastItm = UBound(oldTxt)

    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, ws.Name, dataWS, vbTextCompare) > 0 Then
            For i = firstItm To lastItm
                ws.Cells.Replace _
                    What:=oldTxt(i), _
                    Replacement:=newTxt(i), _
                    LookAt:=xlWhole, _
                    MatchCase:=False
            Next
        End If
    Next

End Sub

工作表名称包含＆＃34;数据＆＃34;或＆＃34;数据＆＃34;将被处理
查找和替换也不区分大小写
使用＆＃34; LookAt：= xlPart＆＃34;部分匹配

编辑子以使用与每个字符串数组合的字符串数组

3 个答案: