全てが同じ得点である生徒名を抽出したいが?

Question 80.2 Excel VBA Borad (掲示板)より Previous Next
データ ご教授お願い致します。
右表のように、生徒名と各科目の点数を表したデータがあります。
各生徒の各科目の点数を順番に参照していき、全てが同じ得点である生徒名を抽出したいのですが。

(例)では生徒名 1 と 3 が全て同得点しているので、1,3 が抽出できるようなマクロを作りたいのですが。
マクロは初心者です。よろしくお願いします。
Answer   2004.12.22 もてもて
結果 こんな感じ?
Sub test()
---------------------------------------------
11  Const タイトル行 = 1
12  Const 科目数 = 3
---------------------------------------------
20  Dim endRow As Integer, writeRow As Integer, myCnt As Integer
21  Dim i As Integer, j As Integer, r As Integer
22  Dim myName As String
23  Dim myCHK As Boolean
24  Dim myArray
30  endRow = Cells(Rows.Count, 1).End(xlUp).Row
31  myArray = Range(Cells(1, 1), Cells(endRow, 科目数 + 2)).Value
32  Worksheets.Add
33  writeRow = 2
40  For i = タイトル行 To endRow
41      If i = タイトル行 Then
42          For r = 1 To 科目数 + 1
43              Cells(1, r).Value = myArray(タイトル行, r)
44          Next r
50      Else
51          If myArray(i, 科目数 + 2) <> "ck" Then
52              myCnt = 1
53              myName = myArray(i, 1)
54              For j = i + 1 To endRow
55                  myCHK = True
60                  For r = 2 To 科目数 + 1
61                      If myArray(i, r) <> myArray(j, r) Then
62                          myCHK = False
63                          Exit For
64                      End If
65                  Next r
70                  If myCHK = True Then
71                      myName = myName & "・" & myArray(j, 1)
72                      myArray(j, 科目数 + 2) = "ck"
73                      myCnt = myCnt + 1
74                  End If
75              Next j
80              If myCnt > 1 Then
81                  Cells(writeRow, 1).Value = myName
82                  For r = 2 To 科目数 + 1
83                      Cells(writeRow, r).Value = myArray(i, r)
84                  Next r
85                  writeRow = writeRow + 1
86              End If
90          End If
91      End If
92  Next i
End Sub
 ※ 行番号はWebマスターが加筆しました。
ありがとうございました
もてもてさん、ありがとうございます。すばらしい! 希望通りの結果が得られ大変感謝しております。
質問では科目3まででしたが、実際はMAX10科目あります。わからないまま
Const 科目数 = 310 に書き換えて実行したらうまくいきましたが、やり方として正解なのでしょうか?

いづれにしましても初心者には非常に難解なコードであることは確かです。このようなコードがすらすら書けるよう、これからも努力していきたいと思います。 時間があれば、この処理の基本的な考え方を、教えていただければ幸いです。
Answer   2004.12.24 もてもて
行番号 コメント
11~12Const で定数としてタイトル行と科目数を設定してます。(不明だった為、直せるように意図して記述。固定ならマクロ内でダイレクトに数値を使用してもOK)
20~24変数の宣言
30データの最終行取得
31データ数が多い場合、シートで処理するとレスポンスが悪い場合があるので、myArrayという配列型の変数にシートの値を代入。(配列に格納せず、シートで処理しても良い)
チェックフラグ用にデータ列より1フィールド多く取っています。
32結果を書き出すシートを追加
33結果を書き出す先頭行を指定
40~92タイトル行から最終行までループ
41~44ループ行がタイトル行だった場合の処理 
42~441列目から科目数+1列目までループ(列数は科目数分の列と人名の列があるので)
431行r列目に配列のタイトル行r列の値を代入
50~90ループ行がタイトル行でない場合
51~90もし配列の最終フィールドの値がckでない場合(下の方で1度処理した行にckとフラグを入れています。重複して書き出さないためにフラグがckの場合は飛ばしてしまうという意味)
52同じ点数の人が何人いるかカウント初期値で1人にする。
53myNameにi行目の人名を代入
54~75i行目の次の行から最終行までループ
55myChkは点数が同じかどうか判断するフラグ初期値をTrueにする  
60~65科目の全列をループ
61~64もしi行目の点数とj行目の点数が違った場合
62フラグをFalseに変える
63点数が違っているので以降の列を見る必要がないので点数チェックのループから抜ける。
70~74点数が違う場合は、上記のチェックでmyCHK=False点数が全て同じだった場合はmyCHK=True、もしmyCHKがTrueだったら 
71人名を代入してある変数myNameに新たな人名を追加
721度処理したので、j行目にckとフラグを代入
73同じ点数の人員カウントアップ
80~86もしmyCntが1より大きい場合、同じ点数の人がいたと言う事なので、myCnt>1の場合だけ処理   
81writeRow行の1列目に人名のmyNameを代入
82~84科目の列をループ
83writeRow行のr列目に配列のi行r列目の値を代入
85書き込みを行ったので、書き込み行変数writeRowをカウントアップ
 ※ もてもてさんの回答を Webマスターが表形式に編集しました。
ご丁寧にありがとうございます
まさか各行の解説がいただけるとは・・・!
おかげさまで処理フローがよく理解できました。しかし、処理法の理解と実際に記述できるかどうかは別物であることも痛感しました。

 

Excel VBA Macro