蟹の種類と数を数えよう（完結編） - Infomentのブログ～Excel VBA奮闘記～

先日、蟹の種類を数えてみた。
infoment.hatenablog.com

するとimihitoさんから、大変貴重なアドバイスをいただいた。
また生物学上はヤドカリな蟹たちを除外したのは、特産地の皆様やファンの方々に申し訳ないことをしたと反省。

以上を踏まえ、大幅改修することにした。
f:id:Infoment:20200508230338j:plain

変更点

辞書の部分を抜き出してプロシージャ分割。
タラバガニもちゃんと数える。
MatchCollectionをMatchに切り替え、コードを簡素化。
With ステートメントを用いて変数の数を抑える。
その他諸々、細々と修正。

Sub 蟹を探せ()
    ' 元の文字列。
    Dim source As String
        source = "タラバガニ毛ガニカニカマ毛ガニ越前蟹タラバガニ花咲蟹越前蟹カニカマ越前蟹ズワイガニアフガニスタン越前蟹アフガニスタンカニカマ"
        
    Dim Dict As Scripting.Dictionary
    Set Dict = 蟹辞書(source)
        If Dict Is Nothing Then
            Debug.Print "蟹は全て逃げたらしい。"
        Else
            Dim mykey As Variant
            For Each mykey In Dict.Keys
                Debug.Print mykey & "：" & Dict.Item(mykey) & " 匹"
            Next
        
        ' 辞書のkey情報（Dict.keys）は配列であるため、UBoundで蟹の種類数を取得。
        ' ※０始まりの配列なため、今回は+1している。
            Debug.Print "※蟹は全部で " & UBound(Dict.Keys) + 1 & " 種類（生物学上の分類不問）。"
            Debug.Print "※同種でも産地別の呼び名があれば、別種として扱う。"
        End If
End Sub

Function 蟹辞書(source As String) As Scripting.Dictionary
    ' 除外用配列。
    Dim ExclusionArray As Variant
    ' 「カニ」「ガニ」という文字を含んでいるが、生き物の名前ではない
    ' 言葉を除外するための配列。
        ExclusionArray = Array("アフガニスタン", "カニカマ")
        
    ' ループ変数。
    Dim arr As Variant
    Dim m As VBScript_RegExp_55.Match
    ' 蟹の名前以外を、vbNullStringに置き換える。
        For Each arr In ExclusionArray
            source = Replace(source, arr, vbNullString)
        Next

    ' パターンに該当したカニを、種類ごとに数えるための辞書。
    ' ※Microsoft Scripting Runtime参照設定済み。
    Dim Dict As Scripting.Dictionary
    Set Dict = New Scripting.Dictionary
        With New VBScript_RegExp_55.RegExp
        ' パターン定義。
        ' ○○ガニ 若しくは ○○蟹（※〇〇は一文字以上の文字列）というパターン。
            .Pattern = "(.+?)(ガニ|蟹)"
        ' 文字列全体を検索する（該当するパターンが見つからなくなるまで探す）。
            .Global = True
                
            For Each m In .Execute(source)
            ' 辞書に格納済みか（＝存在するか）確認。
            ' 存在するならば、蟹の名前（key）に対する匹数（item）を
            ' カウントアップする。
            ' ※引数ではなく匹数。
                If Dict.Exists(m.Value) Then
                    Dict(m.Value) = Dict(m.Value) + 1
            ' 蟹の名前が辞書に存在しない場合、１匹目として登録。
                Else
                    Dict(m.Value) = 1
                End If
            Next
        End With
        
        If Dict.Count > 0 Then
            Set 蟹辞書 = Dict
        End If
End Function