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

2020年5月4日

概要

文字列内の任意の1文字を別の1文字に置換するスタムワークシート関数を作成しました。置換対象の文字は一度に複数指定できますので、一括処理が可能です。

例えば、普通の数字(1,2,3等のアラビア数字)を丸数字(丸付き数字)に置換したり、その逆を行ったりできます。その他、ハイフンやダッシュなどの見た目が似ている文字を1つの文字に統一したり、機種依存文字を除去したりできます。動作例は下記の通りです。

機能

文字列内の任意の1文字を別の1文字に置換します。第2引数の検索文字と、第3引数の置換文字は、それぞれ1つの文字列で指定します。例えば、「1」を「a」、「2」を「b」、「3」を「c」に置換する場合、検索文字は「123」、置換文字は「abc」と指定します。なお、置換文字を1文字指定した場合、全ての検索文字は指定した1文字で置換されます。また、置換文字を省略するか、空文字を指定した場合、検索文字は削除(空文字で置換)されます。

構文

SUBCHARS(文字列 , 検索文字, [置換文字] )

引数説明引数の指定既定値
文字列置換対象の文字列を指定します。必須(無し)
検索文字検索文字を指定します。2文字以上の文字は1つの文字列で指定します。必須(無し)
置換文字置換文字を指定します。2文字以上の文字は1つの文字列で指定します。文字数は、0文字、1文字、又は第2引数の文字数以上である必要があります。
省略可能(空文字)

コード

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

'* @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

ソースコードの利用について

本ソースコードは「GPL v3.0(GNU General Public License Version 3.0)」ライセンスで利用可能です。

本ソースコードを私的に利用される方は、本ソースコードが無料で利用できると考えて差し支え御座いません。下記の著作権表示をソースコード内に表示して頂ければ幸いです。

Copyright © 2017 黒い箱の中 All Rights Reserved.(https://kuroihako.com/)

本ホームページのソースコードを利用したソフトウェアを商用利用したり、ホームページ等で一般公開する方は、本ホームページのソフトウェアまたはソースコードに適用されているライセンスをご理解頂いてからご使用ください。同ライセンス以外での利用をご希望の方はお問い合わせフォームよりご連絡下さい。