【VBA】選択したセルの範囲内で文字列を含むセルの数をカウントする

Option Explicit

Sub CountOsakaCity()
    Dim keywords() As Variant
    
    keywords = Array("大阪市", "堺市")
    
    Call CountKeywords(keywords)
End Sub

Private Sub CountKeywords(ByVal keywords As Variant)
    ' ツール > 参照設定 > Microsoft Scripting Runtime
    Dim KeywordDict As New Dictionary    ' キーワードをキーにしたディクショナリ
    Dim Key As Variant                   ' キーワード
    Dim Rng As Variant                   ' セル
    Dim Msg As String                    ' メッセージ
    Dim SelectionNum As Long             ' 選択範囲のセルの数
    Dim HitNum As Long: HitNum = 0       ' キーワードにヒットした総数
    
    ' キーワードでDictionaryを生成する
    For Each Key In keywords
        KeywordDict.Add Key, 0
    Next Key
    
    ' 選択範囲内の数
    SelectionNum = selection.Count

    ' 選択範囲にキーワードが含まれるかカウントする
    For Each Rng In selection
        For Each Key In KeywordDict
            If Rng.Value Like "*" & Key & "*" Then
                KeywordDict(Key) = KeywordDict(Key) + 1
                Exit For
            End If
        Next Key
    Next Rng
    
    
    Msg = "総件数:" & SelectionNum & vbCrLf
    For Each Key In KeywordDict
        Msg = Msg & Key & ":" & KeywordDict(Key) & vbCrLf
        HitNum = HitNum + KeywordDict(Key)
    Next Key
    Msg = Msg & "その他:" & SelectionNum - HitNum
    
    MsgBox Msg, vbOKOnly, "確認"
    
End Sub

 

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

CAPTCHA