ExcelでCOUNTGを使う

PC 言 技

表内の特定項目内のデータの種類を集計したいという要望があり、自前の関数ストックから改良版を作成したのでここにも掲載しておきます。需要あるかな？
　
　
エクセルの指定範囲内に存在するデータをカウントするCOUNT関数に似ていますが、重複データを１つと見なします。
強いて言うなら CountGroup関数 という感じで、引数範囲に含まれるデータの種類をカウントできます。
　
範囲内に、「a」「b」「c」「c」「d」とデータがあった場合、Count関数やCountA関数では５とカウントしますが、本関数は４（cが重複するので４種類のデータ）とカウントします。
データの数ではなく、重複を除いたデータリストそのものを取得したい場合は、COUNTG関数が内部から呼ぶLISTG関数を使うことで、該当データを配列変数として取得できます。
（※COUNTG関数の動作にはLISTG関数が必要です。それぞれスコープの通ったモジュール内に置いて下さい）
　
　
見て分かるとおり、LISTG関数（つまりCOUNTG関数も）は複数列、複数行、複数Rangeに対応しています。
ヌルや空文字はカウント対象にしていません。
範囲内のセルが全て空文字だった場合（列挙すべきデータが無かった場合）は、長さゼロの配列に空文字が入ったもの（array("")に相当）が返ります。
　
　
COUNTG関数

Public Function COUNTG(TargetArea As Range) As Variant
    ' 指定範囲のデータの種類を返す
    Dim Groups As Variant
    
    ' 要素抽出関数をコール
    Groups = LISTG(TargetArea)
    
    ' 返値の配列をチェック
    If (UBound(Groups) = 0) And _
       (Groups(0) = "") Then
        ' 配列内にデータが無い
        COUNTG = 0
    Else
        ' 要素数を返す
        COUNTG = UBound(Groups) - _
                 LBound(Groups) + 1
    End If
End Function

　
LISTG関数

Public Function LISTG(TargetArea As Range) As Variant
    ' 指定されたセル範囲から、同じデータをまとめて配列化
    Dim Groups() As Variant
    Dim CT As Long
    Dim Rng As Range
    Dim ChkVal As Variant
    Dim ScnVal As Variant
    Dim FL As Boolean
    
    CT = 0
    ReDim Groups(CT)
    Groups(CT) = ""
    
    ' 指定セル範囲を全スキャン
    For Each Rng In TargetArea.Areas
        For Each ChkVal In Rng
            ' プリチェック
            If Not IsNull(ChkVal) Then
            If ChkVal <> "" Then
                ' バッファ検索
                FL = False
                For Each ScnVal In Groups
                    If ScnVal = ChkVal Then
                        FL = True
                        Exit For
                    End If
                Next ScnVal
                If Not (FL) Then
                    ' 新出データを追加
                    CT = CT + 1
                    ReDim Preserve Groups(CT - 1)
                    Groups(CT - 1) = ChkVal
                End If
            End If
            End If
        Next ChkVal
    Next Rng
    
    ' 結果を返す
    LISTG = Groups
End Function