文字列の置換

古いデータが入っているエクセルブックを改修する作業をしていた。現在のシステムでも動作させるには、データを変更しなければならない箇所が沢山ある。
普通は「検索と置換」ダイアログで行う。ただ、置換したいデータが複数ある場合、何度も処理するのは大変だ。なのでマクロってみた。
「文字列置換」シートのA列に置換したい文字列、B列に置換後の文字列を入れる。

Dim Sheet As Worksheet
Dim r As Range
Dim terStr, afterStr As String
Dim maxCol, maxRow, i, n As Integer

Set r = Sheets("文字列置換").Range("A1")
Do Until r.Value = ""
    terStr = r.Value
    afterStr = r.Offset(, 1).Value
    For Each Sheet In ThisWorkbook.Sheets
        If Not Sheet.name = "文字列置換" Then
            If Sheet.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then 'データの入っていないシートに UsedRange を使うとエラーが発生するので回避
                maxRow = Sheet.UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
                maxCol = Sheet.UsedRange.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
            End If
            For i = 1 To maxRow
                For n = 1 To maxCol
                    'Replace したくない文字列は、ここで正規表現を使って回避する
                    Sheet.Cells(i, n).Value = Replace(Sheet.Cells(i, n).Value, terStr, afterStr)
                Next
            Next
        End If
    Next
    Set r = r.Offset(1)
Loop

うんうん、ちゃんと変わってる・・・しかし動作が遅い・・・
データ量の多いブックを処理している時は、カーソルがピロピロするのを眺めながら妄想に耽るハメに。
ふと思ったのが「検索と置換」ダイアログで処理した時はやたら速い事。やってる事は同じなのに、この差はいったい・・・
で、oti君に相談、すると「マクロの記録で書き出されたソースをパクってしまえば速くなるかも」
という事で

Dim Sheet As Worksheet
Dim r As Range
Dim terStr, afterStr As String
Dim selectRange As Range

Set r = Sheets("文字列置換").Range("A1")
Do Until r.Value = ""
    terStr = r.Value
    afterStr = r.Offset(, 1).Value
    For Each Sheet In ThisWorkbook.Sheets
        If Not Sheet.name = "文字列置換" Then
            With Sheet
                'セルの範囲を指定する場合
                'Set selectRange = .Range(.Cells(1, 1), .Cells(2, 2))
                'selectRange.Replace What:=terStr, replacement:=afterStr, LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                'シートを指定する場合
                .Cells.Replace What:=terStr, replacement:=afterStr, LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            End With
        End If
    Next
    Set r = r.Offset(1)
Loop

比べ物にならないくらいスピードアップした。困ったときは「マクロの記録」。