範囲を検索し指定の数だけあれば、それを書き出すには

質問

いつも皆さんに大変お世話になっております。またひとつ教えていただきたいことがございます。
組、番号、氏名、数学の点数、英語の点数が表の見出しで、５０名ほどのデータが入っている表があります。この表は２００名ほどのデータの中で、2つの教科ともに１００点を取った者だけが抽出されている表です。
数回実施したテストごとに両教科100点の者だけを抽出し、前のテストの同じ表に付け足しをしているのを「並べ替え」によって、次のようになっています。

組　番号　氏名　　　　数学　英語
１　　２　　佐藤正一　１００　１００
１　　２　　佐藤正一　１００　１００
１　　２　　佐藤正一　１００　１００
１　３５　　山口篤　　１００　１００
２　　９　　加藤稔　　１００　１００
２　　９　　加藤稔　　１００　１００　
６　１１　　原田聡　　１００　１００
６　１１　　原田聡　　１００　１００
６　１１　　原田聡　　１００　１００

やりたいことは、この表から3回名前がある者だけを上から順に拾っていき、別の場所に書き出し、3回とも100点だった者のリストを作りたいということなのです。
出来上がりはこういう感じです。↓
組　番号　氏名　　　　数学　英語
１　　２　　佐藤正一　１００　１００
６　１１　　原田聡　　１００　１００

今のところ、countifをマクロで使う方法などを調べてやってみたのですが自分の理解が不足でうまくいきませんでした。

一番シンプルなマクロの記述で実現できる方法を教えていただきたく存じます。
よろしくお願いします。

回答No.1

kybo · ベストアンサー

Sheet1のC列に名前があるとします。
3回以上出現した場合、Shee2にコピーします。
(Sheet2はあらかじめ用意しておいてください）

Sub macro()
Dim C As Range, I As Integer
For Each C In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
If C.Value = C.Offset(1).Value Then
I = I + 1
If I = 2 Then
C.EntireRow.Copy Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Else
I = 0
End If
Next C
End Sub

お礼

早速のご回答ありがとうございます。
すみません、わからないところがありまして、
If C.Value = C.Offset(1).Value Then
I = I + 1
If I = 2 Then
で、CとCの一つ下が同じかどうかをみて、同じなら変数が１になり、
そのあと、Cの２つ下とを比べるという作業は、
each c in ～　によって行われると考えていいのでしょうか。

補足

あと、すみませんがもう一つ質問させていただきたいのですが、
書きだす場所はこの表の数列右にしたいと思っています。
そこで、C.EntireRow.Copy のところを、「データの表の範囲におけるその行全部」
とするにはどうすればいいのでしょうか。
currentregionとかと組み合わせて簡単にできるものでしょうか。

回答No.3

tom04

こんにちは！
横からお邪魔します。

No.1さんの補足を読ませてもらって・・・

＞書きだす場所はこの表の数列右にしたいと思っています。
＞そこで、C.EntireRow.Copy のところを、「データの表の範囲におけるその行全部」
＞とするにはどうすればいいのでしょうか。

元データが何列あってもよいようにしてみました。
入力されているデータの2列隣りに表示するようにしています。
尚、データ変更があってもそのままマクロが実行できるように
一旦表示されている結果を消去するようにしています。

可能性としてはほどんどないのかもしれませんが、
同姓同名があってもB列の「番号」の重複はないと思いますので、
B列でデータ数を検索しています。

Sub Sample1()
Dim i As Long, endCol As Long
'データの最終列取得
endCol = Range("A1").CurrentRegion.Columns.Count
'すでに表示されている結果を消去
Cells(1, endCol + 2).CurrentRegion.Clear
'項目行を最終列の2列隣りにコピー＆ペースト
Range("A1").Resize(, endCol).Copy Cells(1, endCol + 2)
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
'B列に3個以上存在、かつ最終列の2列右隣りに表示されている「番号」にB列データがない場合は
If WorksheetFunction.CountIf(Range("B:B"), Cells(i, "B")) > 2 And _
WorksheetFunction.CountIf(Columns(endCol + 3), Cells(i, "B")) = 0 Then
'i列のA列～最終列をコピー＆ペースト
Cells(i, "A").Resize(, endCol).Copy Cells(Rows.Count, endCol + 2).End(xlUp).Offset(1)
End If
Next i
End Sub

※　CurrentRegionで最終列を取得していますので、結果表示させるセルは必ず1列以上は空白列が必要です。
※　元データは並び替えしていなくても大丈夫だと思います。m(_ _)m

お礼

大変わかりやすく、汎用性のあるマクロを教えていただき、ありがとうございました。
ご丁寧に本当にありがとうございます。

回答No.2

kybo

>で、CとCの一つ下が同じかどうかをみて、同じなら変数が１になり、
>そのあと、Cの２つ下とを比べるという作業は、
>each c in ～　によって行われると考えていいのでしょうか。

Cの2つ下と比べるという事はしていません。常に1つ下と同じかどうか確認しています。
each c in ～は最初Ｃ2からスタートして、C3、C4と1つづつ下へＣの参照先がずれていきます。

ＣがC2のときはＣ3とC3のときはＣ4と比べます。
2回連続で同じだった場合、コピーしています。

補足

完全にうまく動きました。ありがとうございます。
でも、ぼくの理解が至らず、どういうわけでnext Cに行く前に、次々下へとずれていくのか、構文の意味がつかめません。
勉強してみようと思います。
ありがとうございました。