[Excel]全角英数字のみを半角英数字に変換するカスタムワークシート関数

2020年5月4日

概要

全角英数字だけを半角に変換するカスタムワークシート関数を作成しました。類似のカスタムワークシート関数は下記のとおりです。

全角文字を半角文字に変換する関数としてASC関数が存在しますが、これは全角カタカナ(全角カナ)も半角になってしまいます。しかし、このカスタム関数は全角英数字のみを変換します。

動作例は下記の通りです。A1セルに全角英数字を含む「123ABCアイウ123ABCアイウ」を入力し、A2セルでカスタム関数のHALFWIDTHAN()を呼び出しています。結果は全角の「123ABC」のみが半角に変換され、「アイウ」は全角の状態を維持しています。

機能

全角英数字を半角英数字に変換します。全角カタカナは影響を受けません。引数に文字列以外を指定した場合、戻り値は文字列に変換されます。なお、この関数は既定では下記の記号も半角に変換します。これらの記号を半角に変換したくない場合は、第2引数にFALSEを指定して下さい。

!”#$%&’()*+,-./:;<=>?@[]^_‘{|}~

構文

HALFWIDTHAN(文字列 , [記号の変換] )

引数説明引数の指定既定値
文字列変換する文字列を指定します。必須(無し)
記号の変換7ビット記号に対応する全角記号を半角に変換する場合はTRUE、変換しない場合はFALSEを指定します。省略した場合はTRUEが指定されます。ここで言う”7ビット記号に対応する全角記号”とは、下記の33文字を指します(先頭のスペース含む)。

 !”#$%&’()*+,-./:;<=>?@[]^_‘{|}~
省略可能TRUE

コード

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


'* @fn Public Function HALFWIDTHAN(ByRef Text As Variant, Optional ByVal ConvertTo7bitSymbols As Boolean = True) As Variant
'* @brief 全角英数字を半角英数字に変換します。全角カタカナは影響を受けません。引数に文字列以外を指定した場合、戻り値は文字列に変換されます。
'* @param[in] Text 変換する文字列を指定します。
'* @param[in] ConvertTo7bitSymbols 7ビット記号( !"#$%&'()*+,-./:;<=>?@[\]^_`{|}~)に対応する全角記号を半角に変換する場合はTRUE、変換しない場合はFALSEを指定します。省略した場合はTRUEが指定されます。
'* @return Variant 変換した文字列を返します。
'*
Public Function HALFWIDTHAN(ByRef Text As Variant, Optional ByVal ConvertTo7bitSymbols As Boolean = True) As Variant
    
    '引数が文字列型以外なら引数を文字列に変換して終了
    If (VarType(Text) <> vbString) Then
        HALFWIDTHAN = CStr(Text)
        Exit Function
    End If
    
    
    '引数が空白のみなら処理なし
    If (Trim(Text) = "") Then
        HALFWIDTHAN = Text
        Exit Function
    End If
    
    
    '変換文字のパターン設定
    Dim Pattern As String   '変換対象文字のパターン(Like右辺値)
    
    If (ConvertTo7bitSymbols) Then
        Static FullWidthANSPattern As String
        If (FullWidthANSPattern = "") Then FullWidthANSPattern = "[ ,.:;?!^_/~|‘’" & Chr(-1449) & "()[-}+-=<>¥$%-@0-9A-Za-z]"
        Pattern = FullWidthANSPattern
    Else
        Pattern = "[0-9A-Za-z]"
    End If
    
    
    '変換
    Dim i As Long
    Dim Char As String      '引数Textの文字を1文字ずつ抽出する際の格納先
    Dim Buffer As String    '引数中の変換対象文字を連結するバッファ
    Dim Result As String    '戻り値
    
    For i = 1 To Len(Text)
        Char = Mid(Text, i, 1)
        
        '引数Text中の連続した変換対象文字をBufferに結合していく。
        If (Char Like Pattern) Then
            Buffer = Buffer & Char
            
        Else '変換対象外の文字を検出したら、Bufferを変換して戻り値に結合。その後ろに変換対象外の文字を結合
            
            'Bufferが空ならStrConv()の呼び出しを省略
            If (Buffer = "") Then
                Result = Result & Char
            Else
                Result = Result & StrConv(Buffer, vbNarrow) & Char
                Buffer = ""
            End If
        End If
    Next i
    
    '引数Textの末尾が変換対象文字の場合は、ループ内の変換処理を通らないため、ここで変換
    If (Buffer <> "") Then
        Result = Result & StrConv(Buffer, vbNarrow)
    End If
    
    HALFWIDTHAN = Result
End Function

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

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

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

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

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