編輯子使用字符串數組結合使用每個

我想設置一些代碼來自動化我必須在我運行的每週報告上執行的任務。其任務是進入所有'數據'表並做幾次查找和替換，以便引用數據表的報表的其他部分看起來更清晰一些。編輯子使用字符串數組結合使用每個

目前我的代碼看起來與此類似：

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 ws 
If right(ws.name, 4) = "Data"

其次，我嘗試過編輯該查找使用一個數組，我定義每個查找和替換字符串，但似乎無法得到正確的語法。

我認爲一個字符串數組和一個for each循環將適合我想要在這裏實現的，但如果更合適的話，請告訴其他方法。

在此先感謝您的幫助。

來源

2015-05-26 SMLBW

。

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

。含「數據」或「數據」

表名稱將被處理
查找和替換也是不區分大小寫
使用「注視：= xlPart」部分匹配

來源

2015-05-26 12:44:13

非常感謝您的建議。我試圖將你的代碼應用到我的報告中，並且查找和替換部分工作正常，謝謝。不幸的是，它不是在工作表上所要求的，但是當我運行宏時（即使該工作表的名稱中沒有「數據」）並且不會循環到其他工作表中，它將在我所在的表上進行查找和替換。最令人討厭的是，它沒有錯誤，所以我很難看出什麼是錯的。也許它完成了一個循環，但由於某種原因沒有進入下一個循環？有關如何確定發生了什麼問題的任何建議？再次感謝！ – SMLBW

哦，我實際上已經做了一些改變。它不喜歡string（），並且錯誤地表示它期望聲明的結尾如此定義'oldtxt'和'newtxt'作爲變體 - 可能是問題出在哪裏。 – SMLBW

感謝您的反饋意見 - 我的意圖是向您提供一個只需要很少更改的解決方案，但我沒有訪問Excel（新的Windows安裝）。我會檢查（和測試）代碼，並且很快會給您回覆 –

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"))

來源

2015-05-26 11:34:51 shahkalpesh

非常感謝期待你的答覆！我已更新我的代碼以符合您的建議，並且出現不匹配錯誤。在進入每個循環之前，我必須定義/填寫sheetnames數組嗎？ – SMLBW

請參閱有關如何調用該過程的更新文章。 – shahkalpesh

做一個數組，並使用循環：

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

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

來源

2015-05-26 11:35:54

編輯子使用字符串數組結合使用每個

回答

相關問題