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

2022年3月21日

概要

文字列内の任意の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のカスタムワークシート関数を使用する方法 を参照して下さい。
' [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

プログラムの利用について

本プログラムのライセンスは「The MIT License」を適用しています。

本プログラムは無償で利用できますが、本プログラム内の著作権表示及びライセンス表示は削除せずに表示しておいて下さい。

必須ではございませんが、本ホームページのプログラムを書籍またはホームページ等で一般公開したい方は、お問い合わせフォームよりご連絡頂けると幸いです。

スポンサーリンク