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

質問

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

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

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

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

回答No.4

Randomize · ベストアンサー

最も必要スキルを少なく・・・だと何とかして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
に書き換えてください。

お礼

回答ありがとうございます。

#3さんのVBAと迷いましたが、
反復性のある作業であると汲みとっていただけて、
より汎用性の高いスクリプトをご提示いただけたので、
こちらをBAとさせていただきました。

回答を寄せてくださった皆様、ありがとうございました！

回答No.3

imogasi

ピボットテーブルなどやってみてもうまく行かない（注１）。
やはり複数列の該当を数えられる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
D1 D2 D3　＜－見出しのつもり
1月1日 a b c　＜－質問の例では苗字漢字
1月2日 s d f
1月3日 a s d
1月4日 z c c
1月5日 s b s
1月6日 a qq d
1月7日 d s v
1月8日 s d c
1月9日 a c a
1月10日 s b x
1月11日 d d ggg
途中に空白セルが合ってもかまわないと思う。
結果
H列
a
b
c
s
d
f
z
qq
v
x
ggg
ーー
初等的なやり方をやっているので、データ量（セル数）に対して、どれぐらい処理（実行）時間がかかるか、懸念はあるが、１０秒以内で終わるのではないかと思う。
ーーー
このあとは上例ではI列に（I1に)
=COUNTIF($B$2:$D$12,H1)
式を入れて縦方向に式を複写する
結果　H1:I12
a 5
b 3
c 5
s 7
d 7
f 1
z 1
qq 1
v 1
x 1
ggg 1
33　＜－Σで出す
（余談）こういうのを見るとエクセルはdatabase的ソフトとして方法がないなと思う。
このプログラムを少々改造して件数まで出すことも出来そうだが略。

お礼

回答ありがとうございました☆

補足

回答ありがとうございます。

私がたどった思考の流れそのものが冒頭に書かれていて、
やはり皆様こう考えていくけれどもぶつかってしまう問題なのだな、と改めて思いました。
余談もとても共感します。ExcelにうまくハマるDBなら良かったのですが今回のは難関でした。

VBA、参考になります。
こちらも試してみますね。
ありがとうございました。

回答No.2

某HN クロメート(Chromate)（@CoalTar）

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

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

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

お礼

回答ありがとうございました☆

補足

回答ありがとうございます。

COUNTIFは理解しておりますが、避けたい理由はこんな感じです。
・週に1度集計を行い、その都度登場する名前のラインナップが変動する
・翌週には前週に入力されていた名前は誰もいなかったりする
・この集計作業は10以上のブックに対して毎週に行う

毎回新規でCOUNTIFを組み、10のブックそれぞれに作業してはいるのですが、
何より時間がかかるのとヒューマンエラーも起きやすいので、
より簡便・安全な方法があればと思い、質問させていただきました。

回答No.1

marcy1

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

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

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

お礼

回答ありがとうございました☆

補足

回答ありがとうございます。

#2さんの補足にあるような理由から、
今回はCOUNTIFの利用はできれば避けたいところです。