ちょうど今、成績をつけているところです。高校では、この学期に大きな試験を2回実施しているところが多いでしょうか。中間試験、期末試験というやつですね。学校によっては、成績などあまり気にしていないとしか思えないくらい欠席者が多いことがあります。例えば30人中7人とか。人間、体調の悪いことだってあります。しかし統計的に調べれば分かるでしょうが、これは「体調の悪い生徒がたまたま多かった」とは言えない人数でしょう。あまり書きたくはありませんが、経験ではこの人数は学校のいわゆる「偏差値」に強く依存します。ま、何にしても、教員はこうして欠席者が出たときは「見込み点」というのをつけるか、さもなければ再試験を行うことになります。
しかし後者は試験する側が相当大変なやり方です。風邪などで休むとき、1日で済まないことも少なくはないでしょう。1日に2、3科目ありますし、定期試験は数日間続けて日程を取るので、そうしたときは結構な科目数を受験しないことになります。しかも学年、クラス、生徒によって受ける科目が違います（選択科目など）。やはり数日間で再試験をしなければなりませんから、そのための時間割を組む必要があります。特に学期末など、効率的に実施しないと間に合わないのです。そして、厳密には試験は本番用と再試験用の2種類、作らなければなりません。日を空けて試験するのだから漏洩の可能性があるのです。実際には本番の試験で問題用紙を回収して「これで一応漏れない」としていました。問題を憶えている生徒だっているでしょうが、そうするしかありません。大学入試ではないのです。いちいち別の問題を作るなどは負担が大きすぎます。ただでさえ「仕事が多すぎ」と教員のなり手が減っているではありませんか！ 学校全体ではなく各教員レベルで、豆に空いている時間に生徒を呼び出して再試験をしているのを見ることもありますが、ぼくがこうするときは同じ問題でやっていました。しかし相手が5人、10人となるとやはり大変すぎです。試験には50分かかるのです……。
最初に書いた「見込み点」というのは「中間試験でこれだけ取ったのだから期末試験ではこのくらい取るはずだ」と計算するやり方です。これについてはブログの記事にしました。再試験を学校レベルでやっているところは経験では少なかったです。今の学校は見込み点をつけるやり方です。これなら負担も大したことはありません……と言いたいところですが、再試験よりはいいけれど神経も使いますし特に人数が多いと楽ではありません。そこでexcelのvbaで見込み点をつけるコードを書いたのでした。
今学期は試験の欠席者が多く、「さて……」と使おうとしたらすぐコードの欠点が見えてきたので、より使いやすく書き換えました。結果、動画のように簡単に見込み点が計算できます。
getMikomi(block, rate)の形でコールします。blockには見込み点をつけたい試験、元になる試験の2列分を指定します。rateは動画では0.8としています。見込み点は通常の風邪などではやや低めにつけることが多いと思います。その倍率です。前の記事のコードではブロックを2回選択しなければならず、しかも空欄を含むブロックを先に指定しなければなりません。神経を使うので疲れます。この点を解消しました。新しいコードは以下の通りです。
'--------------------------------------------
'見込み点を付ける
'block1, block2は一方が見込み点を付ける元のデータ。
'一方にはデータあり、他方は空欄であること。
'カーソルは、block1かblock2の空欄の高さで、そこへ書き込んで構わない列にセット。
'rateは0.8など、見込み点を付ける際の倍率。
'カーソル位置に見込み点が入るので、それをコピーして使う。
'
Function mikomi(block1 As Range, block2 As Range, rate As Double) As Double
Dim val1, val2, mean1, mean2 As Double
Dim pos1, pos2 As Integer
Dim adrs1, adrs2 As String
Dim r, c, c1, c2 As Integer
adrs = ActiveCell.Address(ReferenceStyle:=xlR1C1)
pos1 = InStr(1, adrs, "R")
pos2 = InStr(1, adrs, "C")
r = Val(Mid(adrs, pos1 + 1, pos2 - pos1 - 1)) '行番号を得る
adrs1 = block1.Cells(1, 1).Address(ReferenceStyle:=xlR1C1)
pos1 = InStr(1, adrs1, "C")
c1 = Val(Mid(adrs1, pos1 + 1)) 'block1の列番号を得る
adrs2 = block2.Cells(1, 1).Address(ReferenceStyle:=xlR1C1)
pos2 = InStr(1, adrs2, "C")
c2 = Val(Mid(adrs2, pos2 + 1)) 'block2の列番号を得る
mean1 = WorksheetFunction.Average(block1)
mean2 = WorksheetFunction.Average(block2)
If IsEmpty(Cells(r, c1).Value) Then 'block1に空あり
val2 = Cells(r, c2).Value 'block2の、対応する行の値
val1 = val2 / mean2 * mean1 * rate '見込み点を計算
mikomi = Round(val1, 2)
Else 'block2に空あり
val1 = Cells(r, c1).Value 'block1の、対応する行の値
val2 = val1 / mean1 * mean2 * rate '見込み点を計算
mikomi = Round(val2, 2)
End If
End Function
'--------------------------------------------
Function getMikomi(block As Range, rate As Double) As Double
Dim block1 As Variant
Dim block2 As Variant
Dim rows As Integer
rows = block.rows.Count
block1 = Range(block.Cells(1, 1), block.Cells(rows, 1))
block2 = Range(block.Cells(1, 2), block.Cells(rows, 2))
getMikomi = mikomi( _
Range(block.Cells(1, 1), block.Cells(rows, 1)), _
Range(block.Cells(1, 2), block.Cells(rows, 2)), rate)
End Function
'--------------------------------------------
言い訳ですが、ぼくはほとんどvbaは使いません。冗長だったり、一般的でない書き方をしているかも知れません。今回は特に指定した範囲のその後の扱いで分からない点があり、使える方法でなんとかした感じです。余裕のあるときに改善します。
