"100円"も数字として合計できるSUM関数を作る

ワークシート関数をFunctionプロシージャで自作してみる遊びです。

前回【SUM関数】を自作してみた時に思い付いたのですが、
今回は「100円＋100円を200にしてくれるSUM関数」を作ってみようと思います。

こんな関数↓ですね。

しれっと※1の1は無視しているのが気遣いです

便利そうなので公式関数ぶった名前「TEXTSUM」にしてみました。

気に入ったら使ってみてください。

ソースコード

' SUM関数 文字列が混じっても計算してくれる版
Function TEXTSUM(ParamArray 数値()) As Double
    
    If IsMissing(数値) Then TEXTSUM = 0: Exit Function
    
    ' 各引数をループ
    Dim 各引数 As Variant
    For Each 各引数 In 数値
    
        ' Rangeの場合
        If TypeName(各引数) = "Range" Then
            TEXTSUM = TEXTSUM + Getセル範囲の合計値(各引数)
        
        ' 配列の場合
        ElseIf IsArray(各引数) Then
            TEXTSUM = TEXTSUM + Get配列の合計値(各引数)
        
        ' ブール値をはじく
        ElseIf 各引数 = True Then
        
        ' 数値の場合
        ElseIf IsNumeric(各引数) Then
            TEXTSUM = TEXTSUM + 各引数
            
        ' 日付以外のテキストの場合
        ElseIf TypeName(各引数) = "String" Then
            If IsDate(各引数) = False Then
                TEXTSUM = TEXTSUM + Get文字列中の第1数値部(各引数)
            End If
                        
        End If

    Next
    
End Function

' Rangeの合計値
Private Function Getセル範囲の合計値(ByVal セル範囲 As Range) As Double
    Dim セル As Range
    For Each セル In セル範囲.Cells
        
        ' 数値を合計
        If IsNumeric(セル.Value) And (セル.Value <> True) Then
            Getセル範囲の合計値 = Getセル範囲の合計値 + セル.Value
        
        ' 文字列中の数値も合計(日付を除く)
        ElseIf TypeName(セル.Value) = "String" Then
            If IsDate(セル.Value) = False Then
                Getセル範囲の合計値 = Getセル範囲の合計値 + Get文字列中の第1数値部(セル.Value)
            End If
        End If
        
    Next
End Function

' 配列の合計値
Private Function Get配列の合計値(ByVal 配列) As Double
    
    Dim 要素 As Range
    For Each 要素 In 配列
    
        ' 本家と違いジャグ配列(配列の中に配列)にも対応
        If IsArray(要素) = False Then
            Get配列の合計値 = Get配列の合計値 + Get配列の合計値(要素)
        
        ' 数値を合計
        ElseIf IsNumeric(要素) And (要素 <> True) Then
            Get配列の合計値 = Get配列の合計値 + 要素
            
        ' 文字列中の数値も合計(日付を除く)
        ElseIf TypeName(要素) = "String" Then
            If IsDate(要素) = False Then
                Get配列の合計値 = Get配列の合計値 + Get文字列中の第1数値部(要素)
            End If
        End If
        
    Next
End Function

' 文字列中の数値取得
Function Get文字列中の第1数値部(ByVal 元の文字列 As String) As Double

    ' 全角を半角にして日本語の１、２、…も拾う
    元の文字列 = StrConv(元の文字列, vbNarrow)

    ' 元の文字列を1文字ごとに数値か判定して返り値に取込
    Dim 取り出す数値テキスト As String: 取り出す数値テキスト = ""
    Dim is数字が登場済 As Boolean: is数字が登場済 = False
    Dim 第n文字 As String
    Dim n As Long
    For n = 1 To Len(元の文字列)
        第n文字 = Mid(元の文字列, n, 1)
        
        ' 数字であれば返り値に加える
        If 第n文字 Like "[0-9]" Then
            取り出す数値テキスト = 取り出す数値テキスト & 第n文字
            is数字が登場済 = True
        
        ' 第1数字登場後であれば、カンマ、小数点も返り値に加える
        ElseIf is数字が登場済 And (第n文字 = "." Or 第n文字 = ",") Then
            取り出す数値テキスト = 取り出す数値テキスト & 第n文字

        
        ' 第1数字登場後に数字以外が来たらExit
        ElseIf is数字が登場済 Then
            Exit For
        End If
        
    Next ' 1文字ずつ判定
    
    ' 完成テキストが数値の場合のみ返す（1.2.3のような複数の小数点があった場合は""を返す）
    If IsNumeric(取り出す数値テキスト) Then
        Get文字列中の第1数値部 = 取り出す数値テキスト
    End If
    
End Function

解説

昨日作成した自作のSUM関数に、
テキスト内の数値を取り出して合計に加えるコードを追加した関数です。

合計処理については、引数をひとつずつ配列/セル/値か判定し、
愚直にFor Each文で足していくストレートなコードです。

詳しい解説はこちらの記事を参照ください。

また、本関数の根幹となる「文字列中の数値を抜き出す関数」も、
文字列を1文字ずつみて数値を抜き出すストレートなコードです。

↑の画像の通り「※1の1は無視」という仕様にするため、
数値登場後に文字列を検知した時点で抽出を止める処理となっています。

詳しい解説はこちらの記事を参照ください。

このTEXTSUM関数、便利は便利なのですが、
よく考えてみるとこの「Get文字列中の第1数値部」こそが便利で、

こんな風に各文字列から数値を取り出すことができます。

そしてこれをやった場合、合計は当然普通のSUMでよいので、
そうなるとTEXTSUM関数はいらない子かもしれません。。。

まあサッと一発で計算してくれる便利さはありますので、
気に入ったら使ってみてください。