Excelで、種類の多いデータの個数を集計したい

Question

Excelを使って添付画像のような表を作成しています。
この表の中に、それぞれの名前が何個あるのか集計しようとしています。

・実際には20列以上のフィールド＆1000行以上のレコードがあります
・入っている名前の種類は100以上あるのでcountifの使用は避けたい
・元の表のデータ配置の変更はできれば避けたい（でもそのほうが楽ならシートコピーします）

田中……◯個
高橋……◯個
といった感じで、
表に入っている名前の個数集計が出せればそれでOKです。

よい方法をご教示ください。
よろしくお願いいたします。

Randomize#1 · Accepted Answer

最も必要スキルを少なく・・・だと何とかして1行に加工してそこからピボットテーブルが簡単なのですが。

作業に反復性もありそうなことなので、なるだけ手間がかからないようにとVBAで組み立ててみました。
以下のコードをマクロに書き込んで見てください。

'=====プログラムここから=====

Public Sub CountNameNum()
    Dim objRange As Range, objSrcRange As Range, objOutputRange As Range
    Dim objDicNameList As Object
    Dim OutputArray() As Variant, CountArray As Variant
    Dim StartRowCount As Long, EndRowCount As Long
    Dim StartColCount As Long, EndColCount As Long
    Dim NowIndex As Long, MaxIndex As Long
    
    '***********ここから設定記述部分です***********

'元のデータが入っている場所の範囲を記入
    ' (列の幅とデータの始まりの行さえ合っていれば終了行は自動調整します)
    Set objSrcRange = Sheets("シート名を記入").Range("A:U")   '見出し+20列のため例はA～Uにしてあります
    
    '結果を表示させたい場所の左上を記入(別のシートでもOK)
    Set objOutputRange = Sheets("シート名を記入").Range("A1")

'***********ここからプログラム本体です***********
    '今回のミソ、Dictionaryオブジェクトの宣言
    Set objDicNameList = CreateObject("Scripting.Dictionary")
    '念のため全消去(なくてもOK)
    objDicNameList.RemoveAll
    '範囲の終了行の調整
    StartColCount = objSrcRange.Column + 1  '左端の列は見出しのため、わざと左端1列削る
    EndColCount = objSrcRange.Column + objSrcRange.Columns.Count - 1
    StartRowCount = objSrcRange.Row + 1     '1行目は見出し行のため、わざと先頭1行を削る
    EndRowCount = objSrcRange.Cells(1).End(xlDown).Row  '最終行は自動判定で取得(見出し列の最終行にあわせられます)
    '修正された範囲でデータ範囲を再定義
    Set objSrcRange = objSrcRange.Worksheet.Range(objSrcRange.Worksheet.Cells(StartRowCount, StartColCount), objSrcRange.Worksheet.Cells(EndRowCount, EndColCount))
    '再定義された範囲から名前を集計開始
    Application.StatusBar = "現在、セルの情報をカウント中です"
    For Each objRange In objSrcRange
        If objRange.Value <> "" Then 'セルの中身が空白の場合はカウントアップしない
            If Not objDicNameList.Exists(objRange.Value) Then
                '今まで出たことのない名前が見つかった場合は名前を登録する
                objDicNameList.Add objRange.Value, Array(objRange.Value, 0)
            End If
            '見つかった人の名前のカウントを+1する
            ' (上で追加しているので、ここの部分でリストに名前がないことはありえない)
            objDicNameList.Item(objRange.Value) = Array(objDicNameList.Item(objRange.Value)(0), objDicNameList.Item(objRange.Value)(1) + 1)
        End If
    Next
    Application.StatusBar = "現在、カウントした結果を出力中です"
    MaxIndex = objDicNameList.Count
    ReDim OutputArray(1 To MaxIndex + 1, 1 To 2)    '見出しのためMaxIndexは1行多くしてます
    OutputArray(1, 1) = "名前"
    OutputArray(1, 2) = "回数"
    '集計した結果を取り出し
    CountArray = objDicNameList.Items
    For NowIndex = 0 To MaxIndex - 1
        OutputArray(NowIndex + 2, 1) = CountArray(NowIndex)(0)
        OutputArray(NowIndex + 2, 2) = CountArray(NowIndex)(1)
    Next
    '結果をExcelの指定セルへ転記
    With objOutputRange.Worksheet.Range(objOutputRange, objOutputRange.Offset(UBound(OutputArray, 1) - 1, UBound(OutputArray, 2) - 1))
        .Value = OutputArray
        'ついでに回数の多い順に並べ替え
        .Sort "回数", xlDescending, , , , , , xlYes
    End With
    '出したものはお方付け
    Application.StatusBar = False
    Set objRange = Nothing
    Set objSrcRange = Nothing
    Set objOutputRange = Nothing
    Set objDicNameList = Nothing
End Sub

'=====プログラムここまで=====

設定部分のシート名とセルの列範囲をいじってあげてください。
私のPCで実行すると、20列×10000行にびっしりランダムに名前を入力した場合(およそ17000人分)、処理に大体7秒かかりました。理論上は、シートに収まれば何行に増えても何列に増えても問題ないと思います。(行数は自動で修正されますが、列数を変更した場合は設定を修正してください)

VBAのほうは、コメントは多めに入れましたが、やや難しい内容になっています。詳しく知りたい場合は、
[vba dictionary]のあたりで検索をするといいでしょう。参考になるURLを2つほど紹介しておきます。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_dictionary.html
http://officetanaka.net/excel/vba/tips/tips80.htm
どちらの内容も同じですが、その内容を、セルの範囲が増えてもいいように等、汎用性を持たせているため、上のプログラムは難しい記述になっています。基本・原理は全く同じです。

最後に、名前順に並べ替えたい場合は、[ソートする]の部分の1行を
.Sort "名前", , , , , , , xlYes
に書き換えてください。

marcy1 · Answer

検索条件を具体的な数値でなくセルを指定することで
　countifでも解決できるのではないかと思います。
　ただし、1回は登録されている名前の入力をする必要が
　ありますけど…。

=countif($c$3:$e$11,g3)
 g3から縦に名前の表を作成。
　上の式をh3に入力し名前の数だけ下にコピー

※　画像の左上a1の場合です。

CoalTar · Answer

>・入っている名前の種類は100以上あるのでcountifの使用は避けたい
とは、なぜ使いたくないのでしょうか？
計算が重くなる？、使い方がわかりにくい？、関数が使えない？

●名前の抽出
1. その1 を適当な列へコピー＆ペースト(F列とする)
2. その2も生の部分のみコピーしてF列の下へ追加して貼り付け
3. その3も同様、名前の部分のみコピーしてF列の下へ追加して貼り付け
4. F列を選択して データ フィルタ フィルタオプションの設定
　  ●指定した範囲
　  リスト範囲 F:F
　  抽出範囲 G1
　  [レ]重複するレコードは無視する
5. [Ctrl]+[G]ジャンプ [セル選択] ●空白セル
6. [Ctrl]+[-]削除 上方向にシフト

新しいデータを追加する場合、名前は追加されませんので、もう一工夫必要になります
数式案だったり、VBA使ったり。

imogasi · Answer

ピボットテーブルなどやってみてもうまく行かない（注１）。
やはり複数列の該当を数えられるCOUNTIF関数が良いだろう。
jこれを多数の人物名でつかすために、式を式複写で作成できるようにするには、重複や漏れの無い人名一覧を
縦１列に作る必要がある。
これもフィルタオプションの設定ではうまく行かない（注２）。
注１、注２　本当は出来るのかもしれないが、あとに出る回答を見てください。
ーー
それでVBAを作ってみた。
判らなくても今回限りの道具として使う手もある。
標準モジュールに
Sub test01()
Dim d(10000) '苗字は一万個以下と仮定
n = 1
For Each cl In Range("B2:D12") '苗字の在るデータ範囲例
If cl = "" Then GoTo p1
For i = 1 To n
If d(i) = cl Then
GoTo p1:
Else
End If
Next i
d(n) = cl
n = n + 1
p1:
Next
For i = 1 To n - 1
Cells(i, "H") = d(i) '結果をH列に書き出す例
Next i
End Sub
・データ範囲の部分を変更。
・苗字が1万以下か（以上なら10000->dim d(20000)のように変える
・書き出す列をH列からどこか適当な列へ
を修正して実行。
ーーーーー
例データ　A1:D12
D1D2D3　＜－見出しのつもり
1月1日abc　＜－質問の例では苗字漢字
1月2日sdf
1月3日asd
1月4日zcc
1月5日sbs
1月6日aqqd
1月7日dsv
1月8日sdc
1月9日aca
1月10日sbx
1月11日ddggg
途中に空白セルが合ってもかまわないと思う。
結果
H列
a
b
c
s
d
f
z
qq
v
x
ggg
ーー
初等的なやり方をやっているので、データ量（セル数）に対して、どれぐらい処理（実行）時間がかかるか、懸念はあるが、１０秒以内で終わるのではないかと思う。
ーーー
このあとは上例ではI列に（I1に)
=COUNTIF($B$2:$D$12,H1)
式を入れて縦方向に式を複写する
結果　H1:I12
a5
b3
c5
s7
d7
f1
z1
qq1
v1
x1
ggg1
33　＜－Σで出す
（余談）こういうのを見るとエクセルはdatabase的ソフトとして方法がないなと思う。
このプログラムを少々改造して件数まで出すことも出来そうだが略。

Excelで、種類の多いデータの個数を集計したい

検索条件を具体的な数値でなくセルを指定することで

この回答への補足

>・入っている名前の種類は100以上あるのでcountifの使用は避けたい

この回答への補足

ピボットテーブルなどやってみてもうまく行かない（注１）。

この回答への補足

最も必要スキルを少なく・・・だと何とかして1行に加工してそこからピボットテーブルが簡単なのですが。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

　検索条件を具体的な数値でなくセルを指定することで