[Excel]任意の文字セットを別の文字セットに置換するSUBCHARSカスタムワークシート関数

コード

下記のコードを全てコピーし、標準モジュール等に貼り付けて下さい。下記のコード表示欄の右上に「Copy」ボタンがありますのでご使用下さい。なお、標準モジュールが何だか分からない方は、 Excelのカスタムワークシート関数を使用する方法 を参照して下さい。

' [Excel]任意の文字セットを別の文字セットに置換するSUBCHARSカスタムワークシート関数 
' Copyright (c) 2020-2024  黒箱 
' This software is released under the MIT License;. 
' このソフトウェアはMITライセンスの下でリリースされています。 

'* @fn Public Function SUBCHARS(ByVal Text As Variant, ByVal OldChars As Variant, Optional ByVal NewChars As Variant = "") As Variant
'* @brief 文字列内の任意の1文字を別の1文字に置換します。変換する文字は複数指定可能です。
'* @param[in] Text 変換する文字列を指定します。
'* @param[in] OldChars 検索文字を指定します。2つ以上の文字は1つの文字列で指定します。
'* @param[in] NewChars 置換文字を指定します。2つ以上の文字は1つの文字列で指定します。文字数は、0文字、1文字、又は第2引数の文字数以上である必要があります。
'* @return Variant 置換後の文字列を返します。
'* @details 置換文字を1文字指定した場合、全ての検索文字は指定した1文字で置換されます。置換文字を省略するか、空文字を指定した場合、検索文字は削除(空文字で置換)されます。NewCharsの文字数がOldCharsの文字数と同じか多い場合、OldCharsのn文字目はNewCharsのn文字目に置換されます。
'*
Public Function SUBCHARS(ByVal Text As Variant, ByVal OldChars As Variant, Optional ByVal NewChars As Variant = "") As Variant

    '引数Text又はOldCharsがEmptyならなら処理なし
    If (IsEmpty(Text) Or IsEmpty(OldChars)) Then Exit Function
    
    '引数が文字列型以外なら引数を文字列に変換
    If (VarType(Text) <> vbString) Then Text = CStr(Text)
    If (VarType(OldChars) <> vbString) Then OldChars = CStr(OldChars)
    If (VarType(NewChars) <> vbString) Then NewChars = CStr(NewChars)
    
    
    Dim i As Long
    Dim j As Long
    
    '検索文字と置換文字の対応表を作成
    Dim OldCharsCount As Long: OldCharsCount = Len(OldChars)
    Dim NewCharsCount As Long: NewCharsCount = Len(NewChars)
    Dim ConversionTable() As String: ReDim ConversionTable(1 To OldCharsCount, 1 To 2)
    
    
    'NewCharsが空文字の場合、置換後の文字は全て空文字
    If (NewCharsCount = 0) Then
        For i = 1 To OldCharsCount
            ConversionTable(i, 1) = Mid(OldChars, i, 1)
            ConversionTable(i, 2) = ""
        Next
    
    'NewCharsが1文字の場合、置換後の文字は全て同じ文字
    ElseIf (NewCharsCount = 1) Then
        For i = 1 To OldCharsCount
            ConversionTable(i, 1) = Mid(OldChars, i, 1)
            ConversionTable(i, 2) = NewChars
        Next
    
    'NewCharsの文字数がOldCharsの文字数と同じか多い場合、OldCharsのn文字目はNewCharsのn文字目に置換。
    ElseIf (OldCharsCount <= NewCharsCount) Then
        For i = 1 To OldCharsCount
            ConversionTable(i, 1) = Mid(OldChars, i, 1)
            ConversionTable(i, 2) = Mid(NewChars, i, 1)
        Next
    
    'NewCharsの文字数がOldCharsの文字数より少ない場合、エラーを返す。
    Else
        SUBCHARS = CVErr(xlErrNA)
        Exit Function
    End If


    '変換
    Dim Char As String      '引数Textの文字を1文字ずつ抽出する際の格納先
    Dim Result As String    '戻り値

    For i = 1 To Len(Text)
        Char = Mid(Text, i, 1)
        
        For j = 1 To OldCharsCount
            If (Char = ConversionTable(j, 1)) Then
                Char = ConversionTable(j, 2)
                Exit For
            End If
        Next
        
        Result = Result & Char

    Next i
    
    SUBCHARS = Result

End Function