凝聚查找/替換Excel腳本

我期待凝聚我的劇本，因爲我仍然有很長的路要走，即使複製和粘貼這將花費我很長時間。我只是想縮小查找/替換函數凝聚查找/替換Excel腳本

Function ZoneChanges() 

Dim MyCell As range 

Worksheets("Sheet1").Activate 
Set MyCell = Application.InputBox(Prompt:="Select a cell", Type:=8) 

MyCell.Replace What:="EE", Replacement:="DA", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 
MyCell.Replace What:="EF", Replacement:="DB", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 

MyCell.Replace What:="EG", Replacement:="DC", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 

MyCell.Replace What:="EH", Replacement:="DD", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 

End Function

謝謝！

來源

2016-03-24 Adam

應該遷移到[codereview.stackexchange.com（http://codereview.stackexchange.com） –

它可能是最好先嚐試代碼評審前落實JapanDave建議的修改，因爲有關於複製粘貼的代碼，除了「代替數據集上的循環」外， – Phrancis

如果你必須做多個查找和替換，你可以把所有的值放在數組中並運行一個循環。問題是，這會比現在慢。但是，純粹爲了縮短代碼，你可以做到這一點。

Function ZoneChanges() 

Dim MyCell As Range 
Dim arrWhat, arrRep, i As Long 

Worksheets("Sheet1").Activate 
Set MyCell = Application.InputBox(prompt:="Select a cell", Type:=8) 
arrWhat = Array("EE", "EF", "EG", "EH"): arrRep = Array("DA", "DB", "DC", "DD") 
    For i = LBound(arrWhat) To UBound(arrWhat) 
     MyCell.Replace What:=arrWhat(i), Replacement:=arrRep(i), LookAt:=xlPart, _ 
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
      ReplaceFormat:=False 
    Next 

End Function

來源

2016-03-24 23:08:06

凝聚查找/替換Excel腳本

回答

相關問題