Excel VBAでグループ毎に集計する方法

ExcelのVBAについて教えてください。

A列 B列
OK 9/21
OK 9/21
NG 9/20
OK 9/20
NG 9/21

とセルに入力されていたときに、各日付ごとにOK、NGの発生回数を出す
場合はどのようにすれば良いのでしょうか？
9/20　OK:1個、NG:1個
9/21　OK:2個、NG:1個

大量のデータを扱うため、できるだけ早い処理方法で実現できる方法を希望しています。

No.1 回答者： tom11 回答日時： 2009/09/22 08:09

VBAでないと駄目ですか。

？？？

エクセルには、ピボットテーブルと言う機能があります。
これだと、エクセルのもともとの機能なので、
早いと思いますよ。簡単だし。

この回答へのお礼

tom11さん
画像まで添付していただきありがとうございます。

今回の目的は、複数ファイルで管理しているテスト結果を、1つのファイルで日毎（週毎）に集計するためにVBAで実現したく。

お礼日時：2009/09/22 23:39

No.2 回答者： imogasi 回答日時： 2009/09/22 09:28

>できるだけ早い処理方法

だったら、
（１）メニューのデーター集計
例
日付グループ計数結合
2009/9/20　11400761
2009/9/20　24400762
2009/9/20　22400762
2009/9/21　13400771
2009/9/21　12400771
2009/9/22　24400782
Ｄ列はＤ２に=A2&B2　を入れて下方向に式を複写
「結合」列でソート
メニューのデーター集計
グループの基準　結合
集計の方法　合計　この画相質問では「データの個数」
集計するフィールド　どの項目でもよいーＯＫ
結果
日付グループ計数結合
2009/9/2011400761
1400761 データの個数
2009/9/2024400762
2009/9/2022400762
2400762 データの個数
2009/9/2113400771
2009/9/2112400771
2400771 データの個数
2009/9/2224400782
1400782 データの個数
6総合計
折りたためば、合計件数だけになる。
また結合列の式を=TEXT(A2,"yyyy/mm/dd")&" "&B2のようにすれば
日付グループ計数結合
2009/9/20112009/09/20 1
12009/09/20 1 データの個数
2009/9/20242009/09/20 2
2009/9/20222009/09/20 2
22009/09/20 2 データの個数
2009/9/21132009/09/21 1
2009/9/21122009/09/21 1
22009/09/21 1 データの個数
2009/9/22242009/09/22 2
12009/09/22 2 データの個数
6総合計
と見やすいかも知れない。
第２レベルで
日付グループ計数結合
12009/09/20 1 データの個数
22009/09/20 2 データの個数
22009/09/21 1 データの個数
12009/09/22 2 データの個数
6総合計
ーーーー
（２）ピボットテーブル
これも知らないのかな。有名で説明略。したこと無ければ、Ｇｏｏｇｌｅで照会すればたくさん説明が出る。
（１）（２）が早いはず。
ーーー
（３）ＶＢＡ
ＶＢＡの経験はあるのかな。この手のコントロールブレークによる集計は、昔は仕事で、まずやらされたもので、プログラマの常識だったが。
色々のやり方があるが、簡単なロジックは
日付＋グループでソート
ＶＢＡでデータ最終行を知る。（Ｅｎｄ（ｘｌｕｐ）利用）
（１）全データ（最終行までの全行）の個々のデータについて繰り返し（ＦｏｒＮｅｘｔ）
（２）比較キーは日付＋グループの文字列を作る。以下「キー」ということとすると
（３）直前行のキーと、今のキーを比較して、キーが変わるまで、件数を足しこみ（＋１する）
（４）その行でキーが変わったら件数合計している変数をキーと共に別セル範囲か別シートに書き出し。
今までの件数合計をクリアして、新しいキーで＋１し、
直前のキーとして、日付＋グループの文字列を作る。
最初行と最終行の処理が少し変える必要があるのでに少し注意が要る。
全体のコードはあえて書かない。勉強のこと。
ーー
エクセルのデータメニューの集計の操作も、エクセルでは内部でこのロジックで処理しているのではないかな。前もってソートしないといけない点などが、それをうかがわせる。

この回答への補足

imogasiさん　ありがとうございます。

今回の目的は、複数ファイルで管理しているテスト結果を、1つのファイルで日毎（週毎）に集計するためにVBAで実現したく質問させていただきました。言葉足らずで申し訳ございません。

VBAでの実現方法についてはアドバイスを頂いた内容でなんとなく想像できました。1つだけ追加で質問です。
・結果を入力しているファイルはそのままにしたいのですが、日付・グループ（OK,NG等）の列のみ別のワークシートにコピーしてからアドバイスをしていただいた処理をしなくてはならないでしょうか？

補足日時：2009/09/22 23:08

No.3 回答者： hotosys 回答日時： 2009/09/23 04:27

Sheet1のデータをSheet2に集計します。

元データの1行目に見出しが無ある場合は、見出し行を作る部分は不要です。
Sub sample()
Dim srcSheet As Worksheet
Dim dstSheet As Worksheet
Dim lastRow As Long
Set srcSheet = Sheets("Sheet1") '元データシート
Set dstSheet = Sheets("Sheet2") '集計シート
dstSheet.Cells.Clear '集計シートクリア
srcSheet.Columns("A:B").Copy dstSheet.Range("A1") '元データを集計シートにコピー
dstSheet.Rows(1).Insert 'フィルタを使うために見出しが必要なので、見出し行を挿入
dstSheet.Range("B1").Value = "日付" '見出を「日付」にする
lastRow = dstSheet.Range("A" & Rows.Count).End(xlUp).Row 'A列を基準に最終行を取得
dstSheet.Range("C2:C" & lastRow).Formula = "=A2&B2" 'countifを使うための作業データをC列に作成
dstSheet.Columns("B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=dstSheet.Range("D1"), Unique:=True '[データ][フィルタ][フィルタオプションの設定]で日付を重複を削除してD列に
dstSheet.Columns("D").Sort Key1:=dstSheet.Range("D2"), Order1:=xlAscending, Header:=xlYes 'D列を並び変える
lastRow = dstSheet.Range("D" & Rows.Count).End(xlUp).Row 'D列を基準に最終行を取得
dstSheet.Range("E2:E" & lastRow).Formula = "=COUNTIF(C:C,""OK""&D2)" 'E列にOKを数える関数を設定
dstSheet.Range("F2:F" & lastRow).Formula = "=COUNTIF(C:C,""NG""&D2)" 'F列にNGを数える関数を設定
dstSheet.Range("E2:F" & lastRow).Copy '計算式を値にするためにコピー
dstSheet.Range("E2:F" & lastRow).PasteSpecial xlPasteValues '値のみ貼り付け
dstSheet.Columns("A:C").Delete 'A:C列を削除
dstSheet.Range("B1").Value = "OK" 'B列の見出し
dstSheet.Range("C1").Value = "NG" 'C列の見出し
dstSheet.Range("A1").Select 'A1を選択(コピーの時の範囲が選択されているので)
End Sub

No.4 ベストアンサー 回答者： _Kyle 回答日時： 2009/09/26 12:47

日付順にソートして上から見ていくのが普通の手法ですが

できるだけ早い処理方法で、ということなので、少し捻ってみました。

・データ数　：　6万行
・日付　：　2009/1/1　～　2009/12/31　の間でランダム
の場合、私の環境だと0.2秒ほどで結果が出ます。

'=====↓　ココカラ　↓================================================
Sub Sample()
　Dim orgAry　 As Variant
　Dim sumAry() As Long
　Dim dayCnt　 As Long
　Dim rtnAry() As Long
　Dim i　　　　As Long
　Dim j　　　　As Long
　
　'とりあえず1982年から2036年まで対応
　ReDim sumAry(30000 To 50000, 0 To 2)
　
　'アクティブシートの、A:B列のデータを読み込む
　With ActiveSheet
　　orgAry = Intersect(.UsedRange, .Range("A:B")).Value
　End With
　
　For i = 1 To UBound(orgAry, 1)
　　If sumAry(orgAry(i, 2), 0) = 0 Then
　　　sumAry(orgAry(i, 2), 0) = 1
　　　dayCnt = dayCnt + 1
　　End If
　　Select Case orgAry(i, 1)
　　　Case "OK": sumAry(orgAry(i, 2), 1) = sumAry(orgAry(i, 2), 1) + 1
　　　Case "NG": sumAry(orgAry(i, 2), 2) = sumAry(orgAry(i, 2), 2) + 1
　　End Select
　Next i
　
　ReDim rtnAry(1 To dayCnt, 1 To 3)
　j = 1
　For i = LBound(sumAry, 1) To UBound(sumAry, 1)
　　If sumAry(i, 0) = 1 Then
　　　rtnAry(j, 1) = i
　　　rtnAry(j, 2) = sumAry(i, 1)
　　　rtnAry(j, 3) = sumAry(i, 2)
　　　j = j + 1
　　End If
　Next i
　
　'アクティブシートのC1セル以下に結果を書き出す
　With ActiveSheet
　　.Range("C1").Resize(dayCnt, 3).Value = rtnAry
　　.Range("C1").Resize(dayCnt, 1).NumberFormatLocal = "yyyy/mm/dd"
　End With
　
End Sub
'=====↑　ココマデ　↑================================================

以上ご参考まで。

この回答への補足

_Kyle様
お礼が遅くなり申し訳ございません。
教えていただいたマクロで試したところ、とても早くてびっくりです。
本当にありがとうございます。

OK,NG以外（AA,BB,CC）に複数の判定をする場合は、そうしたらよいのでしょうか？いろいろ試してみましたがうまく動きませんでした。

補足日時：2009/10/03 01:12