ChatGPTに作ってもろた。メモ用。

SUBSTITUTE()で複数の部分文字列を置換する際、ネストするのが嫌だったので、その回避用。

第1引数: 元の文字列
第2引数: 置換対象部分文字列が入ったセル範囲
第3引数: 置換後文字列が入ったセル範囲
※第2,3引数は次の3点を満たすこと
①置換対象と置換後の登場順が揃っている
②指定のセル数が一致
③1行または 1列のみ選択
→行列同時に複数選択は不可

Function MultiSubstitute(stOriginalText As String, rgFindList As Range, rgReplaceList As Range) As String
    ' Application.Volatile True  ← 今回は不要
    
    Dim lCount As Long
    Dim i As Long
    Dim stFind As String
    Dim stReplace As String
    Dim stResult As String

    ' セル数の一致チェック
    If rgFindList.Cells.Count <> rgReplaceList.Cells.Count Then
        MultiSubstitute = CVErr(xlErrValue)
        Exit Function
    End If

    ' 1行または1列であることを確認（Find側）
    If rgFindList.Rows.Count > 1 And rgFindList.Columns.Count > 1 Then
        MultiSubstitute = CVErr(xlErrValue)
        Exit Function
    End If

    ' 1行または1列であることを確認（Replace側）
    If rgReplaceList.Rows.Count > 1 And rgReplaceList.Columns.Count > 1 Then
        MultiSubstitute = CVErr(xlErrValue)
        Exit Function
    End If

    lCount = rgFindList.Cells.Count
    stResult = stOriginalText

    For i = 1 To lCount
        stFind = CStr(rgFindList.Cells(i).Value)
        stReplace = CStr(rgReplaceList.Cells(i).Value)
        stResult = Replace(stResult, stFind, stReplace)
    Next i

    MultiSubstitute = stResult
End Function