[Excel]文字列の中から任意の文字を抽出するカスタムワークシート関数

2020年5月7日

概要

文字列の中から任意の文字を抽出するEXTRUCTカスタムワークシート関数を作成しました。数字だけを抽出する場合はEXTRUCTNカスタムワークシート関数を、任意の文字を削除する場合はREMOVEカスタムワークシート関数をご使用ください。

EXTRUCT関数の動作例は下記の通りです。

機能

文字列の中から、指定した一連の文字のみを抽出して返します。第3引数の”範囲指定”にTRUEを指定することで、第2引数の”抽出文字”に範囲指定が可能になります。例えば、全ての英数字を抽出したい場合は第2引数の”抽出文字”に"a-zA-Z0-9″を指定します。また、全てのひらがなとカタカナを抽出したい場合は抽出文字に"ぁ-をァ-ヶ"を指定します。なお、範囲指定をする場合はハイフン”-”を抽出文字として指定できなくなります。

構文

EXTRUCT(文字列 , 抽出文字, [範囲指定] )

引数説明引数の指定既定値
文字列抽出対象の文字列を指定します。必須(無し)
抽出文字抽出文字を指定します。2つ以上の文字は1つの文字列で指定します。必須(無し)
範囲指定抽出文字を範囲指定(例:a-z)する場合はTRUE、範囲指定しない場合はFALSEを指定します。省略した場合、FALSEを指定します。省略可能FALSE

コード

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

'* @fn Public Function EXTRUCT(ByRef Text As String, ByVal CharsToExtruct As String, Optional ByVal RangeSpecification As Boolean = False) As Variant
'* @brief 文字列の中から、指定した一連の文字のみを抽出して返します。
'* @param[in] Text 抽出対象の文字列を指定します。
'* @param[in] CharsToExtruct 抽出文字を指定します。2つ以上の文字は1つの文字列で指定します。
'* @param[in] RangeSpecification 抽出文字を範囲指定(例:a-z)する場合はTRUE、範囲指定しない場合はFALSEを指定します。省略した場合、FALSEを指定します。
'* @return Variant 抽出した文字列を返します。
'* @details 文字列の中から、指定した一連の文字のみを抽出して返します。第3引数RangeSpecificationにTRUEを指定することで、第2引数CharsToExtructに範囲指定が可能になります。例えば、全ての英数字を抽出したい場合は"a-zA-Z0-9"を指定します。
'*
Public Function EXTRUCT(ByRef Text As String, ByVal CharsToExtruct As String, Optional ByVal RangeSpecification As Boolean = False) As Variant

    If (Text = "") Then Exit Function

    Dim i As Long
    Dim Char As String
    Dim Result As String

    Dim TextLength As Long: TextLength = Len(Text)

    '抽出文字が1文字の場合の処理
    If (Len(CharsToExtruct) = 1) Then
        
        For i = 1 To TextLength
            Char = Mid(Text, i, 1)
            If (Char = CharsToExtruct) Then Result = Result & Char
        Next
        
        EXTRUCT = Result
        Exit Function
    End If
    
    
    '抽出文字が2文字以上の場合、対象文字を先頭から1文字ずつ Like [charlist]で比較し、不要文字を除去する。
    
    'CharsToExtructにハイフンが含まれる場合、かつ範囲指定(例:a-z)が無効の場合、Like演算子の副作用を防ぐためハイフンを末尾に移動。
    Dim CharsToExtructPattern As String
    If Not (RangeSpecification) Then
        If (CharsToExtruct Like "*-*") Then
            CharsToExtruct = Replace(CharsToExtruct, "-", "") & "-"
        End If
    End If
    
    'CharToExtructに角カッコ ]  が含まれる場合、[charlist]の角かっこが途中で閉じてしまうため、個別に比較する
    If (CharsToExtruct Like "*]*") Then
        CharsToExtructPattern = "[" & Replace(CharsToExtruct, "]", "") & "]"
        For i = 1 To TextLength
        
            Char = Mid(Text, i, 1)
            If (Char Like CharsToExtructPattern) Then
                Result = Result & Char
            ElseIf (Char = "]") Then
                Result = Result & Char
            End If
        Next

    Else
        CharsToExtructPattern = "[" & CharsToExtruct & "]"
        For i = 1 To TextLength
            Char = Mid(Text, i, 1)
            If (Char Like CharsToExtructPattern) Then Result = Result & Char
        Next
    End If

    EXTRUCT = Result

End Function

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

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

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

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

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