を作成した例を掲げています。
App-3.1 基礎データの準備
先ず、事前の準備として次のことをしましょう。
1）各教科の成績表を夫々、シート名「国語」、「数学」、「社会」、「理科」、「英語」の順に
準備して下さい。
学年、組、生徒番号、名前、点数を入力します。
2）表中のSS、順位、累積数を求めて下さい。
SS〜Ｇ６セルの内容は =10*(F6-$L$2)/$L$3+50
順位〜Ｈ６セルの内容は =RANK(F6,$F$6:$F$155,0)
なお、赤字155はサンプルデータの最終行（以下、同様）です。
累積数〜Ｉ６セルの内容は =RANK(F6,$F$6:$F$155,1)
7行目以下のセルについては、オートフィル機能を用いて求めます。
3）成績表全体のセル範囲を「○○成績名簿表」の名前で登録して下さい。
4）図App-3.1に倣い、所定のセルに平均値、標準偏差値を準備して下さい。
平均値〜Ｌ２セルの内容は =AVERAGE(F6:F155)
標準偏差値〜Ｌ３セルの内容は =STDEVA(F6:F155) （標本の標準偏差の意味です）
5）得点分布グラフを描くための準備として、所定の区間、範囲に分けて累積人数、各階級
毎の人数を下式を参照して求めます。中央値は数値データとして与えています。
累積人数〜Ｏ６セルの内容は =FREQUENCY($F$6:$F$155,K6)
人数 〜Ｎ６セルの内容は =$O6
Ｎ7セルの内容は =$O7-$O6
それ以下のセルについては、オートフィル機能を用いて求めます。
6）中央値、人数の欄2列を全ての区間について選択し、横棒グラフを作成して下さい。
以上、1）〜6）迄に関しては、5教科全てについて準備します。なお、生徒の名前は1年2組
を除き、省略しました。
図 App-3.1 国語成績表 （シート全体はこちら、国語成績整理.pdfへのリンク）
7）新たなシートに、「5教科合計」の名前を付けて下さい。
8）合計点数の欄は、シート間にまたがる和の計算となります。
合計点数〜Ｆ６セルの内容は =SUM(国語:英語!F6)
7行目以下のセルについては、オートフィル機能を用いて求めます。
その他の欄〜各科目の場合と同じです。
9）完成した表を「五教科成績名簿表」として、登録して下さい。
10）あらたなシートに「個人成績抜粋」の名前を付けて下さい。
11）次ページ図App-3.3を参照して、見出し行のタイトルと罫線枠を準備して下さい。
12）Ｂ4：Ｌ8の範囲を「個人成績抜粋表」の名前で登録します。
図 App-3.2 5教科合計成績表
App-3.2 個人成績データ
ここでは、図App-3.3に示すような各生徒の成績表と全体に対する各生徒の得点の位置
づけを表すグラフを想定しています。
図 App-3.3 （シート全体はこちら、個人成績抜粋.pdfへのリンク）
上段の個人成績データ表は、App-3.1で準備した6つのシート全てを参照して、該当者の
データを抜き出し作成しています。全生徒の個人表を一般操作で作成するにはかなりの時間
を要し、ミスの誘発にも繋がります。「マクロの記録」もこの例では有効で無さそうです。以下
には、マクロプログラムの例を紹介します。
作成の基本方針
・見出し欄はあらかじめ所定の位置に作成済とする。
・「5教科合計」シートの表において、個人データ表を作成する生徒番号のセルを赤で塗り
つぶす。
・一括して複数生徒分の表を作成しない。
プログラムのフロー
1）「5教科合計」シートの「五教科成績名簿表」の見出しを除く3行目から走査を開始
する（生徒番号欄が赤で塗りつぶされているセルが見つかる迄）。
2）該当セルが見つかったら、学年〜順位の各データを夫々の変数名に代入する。
3）各変数に代入されたデータを「個人成績抜粋表」に転記する。
平均点、ＳＳは小数点以下第1位まで表示（第2位四捨五入）
以上は、5教科の合計に関する記述です。
4）各科目について、上の1）、2）、3）と同様の操作を行なう。
ただし、該当セルは、上の2）で代入されたクラス名、生徒番号に等しい生徒である
ことを条件として捜す。
5）最後に、表全体を選択して文字列のセンタリングを行なう。
「個人成績抜粋」マクロプログラム
1 Sub 個人成績抜粋()
2 Dim masterTbl As Range, masterTbl_3 As Range
3 Dim grade As Integer, class As Integer, student_no As Integer
4 Dim total As Integer, ranking As Integer, score As Integer
5 Dim student_name As String, subj As String, name_table As String
6 Sheets("5教科合計").Select
7 Set masterTbl = Range("五教科成績名簿表")
8 For i = 3 To masterTbl.Rows.Count
9 '見出しを除く3行目から最終行までの繰り返し
10 'iはmasterTbl内での相対的な行番号
11 If masterTbl.Cells(i, 3).Interior.ColorIndex = 3 _
12 And masterTbl.Cells(i, 3).Interior.Pattern = xlSolid Then
13 grade = masterTbl.Cells(i, 1) '学年
14 class = masterTbl.Cells(i, 2) '組
15 student_no = masterTbl.Cells(i, 3) '生徒番号
16 student_name = masterTbl.Cells(i, 4) '生徒氏名
17 total = masterTbl.Cells(i, 5) '合計点
18 avetotal = Range("L2") '合計平均点
19 ss = masterTbl.Cells(i, 6) 'SS
20 ranking = masterTbl.Cells(i, 7) '順位
21 Exit For
22 End If
23 Next
24 '
25 Sheets("個人成績抜粋").Select
26 Set masterTbl = Range("個人成績抜粋表")
27 masterTbl.Cells(2, 1) = grade
28 masterTbl.Cells(2, 2) = class
29 masterTbl.Cells(2, 3) = student_no
30 masterTbl.Cells(2, 4) = student_name
31 '
32 Selection.Interior.ColorIndex = xlNone
33 Set masterTbl = Range("個人成績抜粋表")
34 masterTbl.Cells(2, 11) = total
35 masterTbl.Cells(3, 11) = avetotal
36 masterTbl.Cells(3, 11).Select
37 Selection.NumberFormatLocal = "0.0_ "
38 masterTbl.Cells(4, 11) = ss
39 masterTbl.Cells(4, 11).Select
40 Selection.NumberFormatLocal = "0.0_ "
41 masterTbl.Cells(5, 11) = ranking
42 For i = 1 To 5
43 If i = 1 Then
44 subj = "国語"
45 name_table = "国語成績名簿表"
46 ElseIf i = 2 Then
47 subj = "数学"
48 name_table = "数学成績名簿表"
49 ElseIf i = 3 Then
50 subj = "社会"
51 name_table = "社会成績名簿表"
52 ElseIf i = 4 Then
53 subj = "理科"
54 name_table = "理科成績名簿表"
55 Else
56 subj = "英語"
57 name_table = "英語成績名簿表"
58 End If
59 Sheets(subj).Select ' 各科目成績転記
60 Set masterTbl_3 = Range(name_table)
61 '
62 For k = 3 To masterTbl_3.Rows.Count
63 If masterTbl_3.Cells(k, 2) = class And masterTbl_3.Cells(k, 3) = student_no Then
64 score = masterTbl_3.Cells(k, 5)
65 avescore = Range("L2")
66 ss = masterTbl_3.Cells(k, 6)
67 ranking = masterTbl_3.Cells(k, 7)
68 '
69 Sheets("個人成績抜粋").Select
70 masterTbl.Cells(2, 5 + i) = score
71 masterTbl.Cells(3, 5 + i) = avescore
72 masterTbl.Cells(3, 5 + i).Select
73 Selection.NumberFormatLocal = "0.0_ "
74 masterTbl.Cells(4, 5 + i) = ss
75 masterTbl.Cells(4, 5 + i).Select
76 Selection.NumberFormatLocal = "0.0_ "
77 masterTbl.Cells(5, 5 + i) = ranking
78 End If
79 Next
80 Next
81 '文字列センタリング
82 Range("B5:L8").Select
83 With Selection
84 .HorizontalAlignment = xlCenter
85 .VerticalAlignment = xlCenter
86 End With
87 Set masterTbl = Nothing 'オブジェクトの開放
88 Set masterTbl_3 = Nothing
89 End Sub
科目別平均点＆個人点グラフ作成
このグラフは、棒グラフで各科目の平均点、折れ線グラフで個人の得点を表示しています。
作成手順
1）Ｆ5：Ｋ6のセルを選択し、先ず棒グラフを描きます。
2）素点の棒グラフのみを選択し、右クリックし、メニューから「グラフの種類」を選びます。
「折れ線グラフ」を指定して完成です。
3）一度このグラフが描かれると、それ以降異なる生徒については、個人成績データ表が
完成すると同時にグラフも自動的に切り替わります。
合計得点分布、各科目得点分布グラフ
Ａｐｐ_3.1「基礎データの準備」の手順6）で描いた得点分布グラフを「個人成績抜粋」シート
にコピーします。この全生徒の得点分布図に、個人得点を黄色の☆印で表示します。マウス
を任意の横棒に近づけると中央値が表示されるので、それを頼りに☆印を移動します。
事前に以下の準備をしておくと、作業が簡単になります。
1）黄色の☆印6つを個人成績データ表の右横に作成しておいて下さい。
2）10行目を選択し、表を含む形でウィンドウ／ウィンドウ枠の固定を選択して下さい。
これは、表を参照しながら☆印を各グラフの所定の位置に移動するための準備です。
なお、必要であれば右下の空いたスペースをコメント欄とします。
App-3.3 五教科総合成績ランキング
ここでは、下に示すような5教科総合成績順位の一覧表を作成します。作業内容は、成績
上位者から先頭に並べ替えるソートです。なお、名前欄が空欄のセルは、基礎データの準備
で名前の入力を省略したセルです。
図 App-3.4 5教科総合成績ランキング表
事前準備
・シート名「5教科合計ランキング」を新たに用意する。
・見出しなどの常に記入文字が固定されているセルは、事前に入力済としておく。
・B4：I604のセル範囲（余裕を持って600行300人のランキングまで対応可能）を選択し、
「合計ランキング表」の名前で登録する。
作成の基本方針
・表示項目は、順位、名前の他、5教科合計および各科目の素点（上段）、SS（下段）とする。
・1位から何位までのランキング表とするかは、所定のセル（F2）に事前に与える。
・既存のランキング表がある場合でも支障の無いようセル内容のクリアー、罫線の削除を
考慮する。
プログラムのフロー
1）「5教科合計」シートの「五教科成績名簿表」の順位を基に、順位1位から走査する。
複数の生徒が同順位となる場合もあるので、常に表の最初から最後までを走査する。
2）初回のループにおいて、既存ランキング表のセル内容をクリアー、罫線を削除する。
3）必要データの転記をする。コードは、殆ど「個人成績抜粋」マクロプログラムに同じ。
4）1名追加される毎に、罫線の記入、文字列のセンタリングを行なう。
「五教科総合成績ランキング」マクロプログラム
1 Sub 五教科合計ランキング()
2 Dim masterTbl_1 As Range, masterTbl_2 As Range, masterTbl_3 As Range
3 Dim grade As Integer, class As Integer, student_no As Integer
4 Dim total As Integer, ranking As Integer, score As Integer
5 Dim irow As Integer
6 Dim student_name As String, subj As String, name_table As String
7 Dim myAdr As String
8 total_rank = 1
9 irow = 0
10 Sheets("5教科合計ランキング").Select
11 end_ranking = Range("F2") 'F2セルに代入された数値順位までのランキング
12 While total_rank <= end_ranking
13 Sheets("5教科合計").Select
14 Set masterTbl_1 = Range("五教科成績名簿表")
15 ic = 0
16 For i = 3 To masterTbl_1.Rows.Count
17 '見出しを除く3行目から最終行までの繰り返し
18 'iはmasterTbl内での相対的な行番号
19 If masterTbl_1.Cells(i, 7) = total_rank Then
20 ic = ic + 1
21 irow = irow + 1
22 class = masterTbl_1.Cells(i, 2) '組
23 student_no = masterTbl_1.Cells(i, 3) '生徒番号
24 student_name = masterTbl_1.Cells(i, 4) '生徒氏名
25 total = masterTbl_1.Cells(i, 5) '合計点
26 ss = masterTbl_1.Cells(i, 6) 'SS
27 ranking = masterTbl_1.Cells(i, 7) '順位
28 '
29 Sheets("5教科合計ランキング").Select
30 If total_rank = 1 And ic=1 Then
31 Range("B5:I604").Select '既存ランキング表600行分のセル内容クリアー
32 Selection.ClearContents
33 '既存ランキング表の罫線クリアー
34 Selection.Borders(xlEdgeLeft).LineStyle = xlNone
35 Selection.Borders(xlEdgeBottom).LineStyle = xlNone
36 Selection.Borders(xlEdgeRight).LineStyle = xlNone
37 Selection.Borders(xlInsideVertical).LineStyle = xlNone
38 Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
39 End If
40 Set masterTbl_2 = Range("合計ランキング表")
41 '600行300人分登録，必要最小限の最大値＝（合計人数×2＋1）行分登録
42 masterTbl_2.Cells(2 * irow, 1) = ranking
43 masterTbl_2.Cells(2 * irow, 2) = student_name
44 masterTbl_2.Cells(2 * irow, 3) = total
45 masterTbl_2.Cells(2 * irow + 1, 3) = ss
46 masterTbl_2.Cells(2 * irow + 1, 3).Select
47 Selection.NumberFormatLocal = "0.0_ "
48 For j = 1 To 5
49 If j = 1 Then
50 subj = "国語"
51 name_table = "国語成績名簿表"
52 ElseIf j = 2 Then
53 subj = "数学"
54 name_table = "数学成績名簿表"
55 ElseIf j = 3 Then
56 subj = "社会"
57 name_table = "社会成績名簿表"
58 ElseIf j = 4 Then
59 subj = "理科"
60 name_table = "理科成績名簿表"
61 Else
62 subj = "英語"
63 name_table = "英語成績名簿表"
64 End If
65 Sheets(subj).Select ' 各科目成績転記
66 Set masterTbl_3 = Range(name_table)
67 For k = 3 To masterTbl_2.Rows.Count
68 If masterTbl_3.Cells(k, 2) = class And masterTbl_3.Cells(k, 3) _
= student_no Then
69 score = masterTbl_3.Cells(k, 5)
70 avescore = Range("L2")
71 ss = masterTbl_3.Cells(k, 6)
72 ranking = masterTbl_3.Cells(k, 7)
73 '
74 Sheets("5教科合計ランキング").Select
75 masterTbl_2.Cells(2 * irow, 3 + j) = score
76 masterTbl_2.Cells(2 * irow + 1, 3 + j) = ss
77 masterTbl_2.Cells(2 * irow + 1, 3 + j).Select
78 Selection.NumberFormatLocal = "0.0_ "
79 End If
80 Next
81 Next
82 '罫線記入
83 ins = 2 * irow + 3
84 myAdr = "B" & CStr(ins) & ":" & "I" & CStr(ins + 1) 'Tips A044
85 Range(myAdr).Select
86 With Selection.Borders(xlEdgeLeft)
87 .LineStyle = xlContinuous
88 .Weight = xlThin
89 .ColorIndex = xlAutomatic
90 End With
91 With Selection.Borders(xlEdgeTop)
92 .LineStyle = xlContinuous
93 .Weight = xlThin
94 .ColorIndex = xlAutomatic
95 End With
96 With Selection.Borders(xlEdgeBottom)
97 .LineStyle = xlContinuous
98 .Weight = xlThin
99 .ColorIndex = xlAutomatic
100 End With
101 With Selection.Borders(xlEdgeRight)
102 .LineStyle = xlContinuous
103 .Weight = xlThin
104 .ColorIndex = xlAutomatic
105 End With
106 With Selection.Borders(xlInsideVertical)
107 .LineStyle = xlContinuous
108 .Weight = xlThin
109 .ColorIndex = xlAutomatic
110 End With
111 Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
112 '文字列センタリング
113 With Selection
114 .HorizontalAlignment = xlCenter
115 .VerticalAlignment = xlCenter
116 End With
117 myAdr = "B" & CStr(ins) & ":" & "B" & CStr(ins + 1) 'Tips A044
118 Range(myAdr).Select
119 Selection.Merge
120 myAdr = "C" & CStr(ins) & ":" & "C" & CStr(ins + 1) 'Tips A044
121 Range(myAdr).Select
122 Selection.Merge
123 End If
124 Next
125 total_rank = total_rank + ic
126 Wend
127 Set masterTbl_1 = Nothing 'オブジェクトの開放
128 Set masterTbl_2 = Nothing
129 Set masterTbl_3 = Nothing
130 End Sub
