目次 前 次

合否判定処理

 
　高校入試の採点後の合否判定を自動化できないかと
　相談されたことがありました。

　1200名の受験者がいて、入学試験の採点は３日で
　終了するのに対して、試験の獲得点数（学力点）
　と学習点を合わせて、ランクづけしての合否判定
　に割当てる時間が１日というので、徹夜作業での
　ミスも考えられる。これを自動化してミスをなく
　して、楽をしたいという内容。

　入試ですから、個人の一生を左右することもある
　ので、ミスは許されない、しかし、楽はしたいと
　いうので、自動化が切実なようでした。

　疲れているとミスが出るので、「徹夜作業などは
　もっての他。」というのが、よくわかります。

　相談を受けたのが、１月上旬で、試験は２月中旬。
　入試の合否発表は、２月下旬というスケジュール
　でしたので、３晩で作成。

　金曜日から日曜日の夜の時間を使い、13種の計算
　方法を試して、最高速で動く処理を探しました。

　spreadsheetは、Lotus1-2-3で、入試の合否判定の
　基になる情報は、フロッピーディスクに入れられて
　ました。
　高速に処理しないと、自動化しても人手との違いが
　出ないと言われては、元も子もないので。

　利用システムは、以下を想定。



　フロッピーディスクに格納されている２ファイルの情報から
　合否判定の判断材料になるファイルを生成後、合否判定して
　から、受験番号を印刷する仕様にしました。

　フロッピーディスクに入れて貰う情報は、次のように規定。

　学習点は、次のように決められていたので
　ランク（ＡからＭ）の１文字を入れるよう
　依頼しておきました。

　学習点の計算方法。

　全教科（９教科）の成績表の値（１から５で表現）
　の総和を求めておきます。

　各学年の成績表の合計値に、重みをつけます。
　　１年次の全学期成績表の合計×２
　　２年次の全学期成績表の合計×２
　　３年次の全学期成績表の合計×３

　重みをつけた３値の総計を求めて、ランクに当てはめ。
　  A 315 - 296
　  B 295 - 276
　  C 275 - 256
　  D 255 - 236
　  E 235 - 216
　  F 215 - 196
　  G 195 - 176
　  H 175 - 156
　  I 155 - 136
　  J 135 - 116
　  K 115 -  96
　  L  95 -  76
　  M  75 -  56

　学力点は、高校側の採点で５教科の得点をフォーマットで
　入力して頂くよう依頼。




　５教科の得点の総和は、spreadsheetで簡単に求められるので
　敢えて、計算しないで欲しいと伝えました。

　受験番号がA列に含まれていれば、５教科の得点をB列からF列に
　入れるとなるので、この仕様で入力だけを依頼。

　得点がB列からF列に含まれているなら、G列に総和を
　格納するとすれば、G列のセルの内容は「=SUM(B2:F2)」。

　計算式をコピーすれば、spreadsheetが自動計算する
　ので、電卓や算盤の計算で発生する人為ミスを防止と
　考えました。

　マクロで処理するなら、次のようにすればOK。

Sub xCalcH()
  Dim objS As Object

  Dim i As Integer
  Dim j As Byte

  Dim xtmp As Integer

  ' set object pointer
  objS = ThisComponent.CurrentController.ActiveSheet

  ' vertical
  FOR i = 1 TO 1200
    ' clear
    xtmp = 0
    ' horizontal
    FOR j = 1 TO 5
      ' add
      xtmp = xtmp + objS.getCellByPosition(j,i).Value
    NEXT j
    ' store
    objS.getCellByPosition(7,i).Value = xtmp
  NEXT i
End Sub


　学力点のファイルには、受験番号、各教科の得点、総得点の
　７種の情報が格納されるようにフォーマットを指定。

　学習点は、中学校側の怠慢なのか、１年から３年の成績表の
　全教科の値しか提出されないとか。
　負担軽減のために、これもspreadsheetで片付けることにして
　受験番号を含めたファイルを作成するように依頼しました。

　学習点の重みをつけた傾斜配点値も、spreadsheetで
　計算して、ランクに相当するアルファベット１文字を
　生成。

　傾斜配点値から、アルファベット１文字の生成は
　マクロを使えば簡単にできると考えました。

　関数をひとつ定義すれば、おしまい。

Function GenRank(x As Int)
  Dim result As String

  ' default
  result = "M"
  ' A 315 - 296
  If x > 295 Then
    result = "A"
  End If
　' B 295 - 276
  If x > 275 AND x < 296 Then
    result = "B"
  End If
  ' C 275 - 256
  If x > 255 AND x < 276 Then
    result = "C"
  End If
　' D 255 - 236
  If x > 235 AND x < 256 Then
    result = "D"
  End If
　' E 235 - 216
  If x > 215 AND x < 236 Then
    result = "E"
  End If
　' F 215 - 196
  If x > 195 AND x < 216 Then
    result = "F"
  End If
　' G 195 - 176
  If x > 175 AND x < 196 Then
    result = "G"
  End If
　' H 175 - 156
  If x > 155 AND x < 176 Then
    result = "H"
  End If
　' I 155 - 136
  If x > 135 AND x < 156 Then
    result = "I"
  End If
　' J 135 - 116
  If x > 115 AND x < 136 Then
    result = "J"
  End If
　' K 115 -  96
  If x > 95 AND x < 116 Then
    result = "K"
  End If
　' L  95 -  76
  If x > 75 AND x < 96 Then
    result = "L"
  End If

  '
  GenRank = result
End Function

　もう少し、うまい方法もあります。

　20で割ったときの商と余りを求めて補正後
　char関数でアルファベットの１文字を取得。

Function GenRank(x As Integer)
  Dim xx As Byte
  Dim q As Byte
  Dim r As Byte
  ' offset
  xx = x - 15
  ' quotient
  q = int(xx / 20)
  ' residue
  r = xx % 20
  ' adjust
  If r = 0 Then
    q = q - 1
  End If

  ' get alphabet
  GenRank = char(79 - q)
End Function

　判定を含むと高速動作できないので、計算と予め用意
　されている関数を活用することがキーポイント。

　この関数は、次のようにセルにデータを展開して
　確認した後、定義。

    

  1. B2に56を格納

  2. B3からは、つぎの式を格納「=B2+1」(最終セルはB261）

  3. C2には、つぎの式を格納「=B2-15」

  4. C3からは、C2の式をコピー(最終セルはC261）

  5. D2には、つぎの式を格納「=INT(C2/20)」

  6. D3からは、D2の式をコピー(最終セルはD261）

  7. E2には、つぎの式を格納「=MOD(C2,20)」

  8. E3からは、E2の式をコピー(最終セルはE261）

  9. F2には、つぎの式を格納「=IF(E2>0,C2,C2-1)」

  10. F3からは、F2の式をコピー(最終セルはF261）

  11. G2には、つぎの式を格納「=char(79-F2)」

  12. G3からは、G2の式をコピー(最終セルはG261）


　この操作をした場合のワークシートの内容は、以下。



　学習点から、ランクを一気に計算するマクロは、以下。

Sub xCalcHH()
  Dim i As Integer

  Dim xtmp As Integer
  Dim ytmp As Integer

  Dim q As Byte
  Dim r As Byte

  ' vertical
  FOR i = 1 TO 1200
    ' get point
    xtmp = ThisComponent.Sheets(0).getCellByPosition(1,i).Value
    ' convert
    ytmp = xtmp - 15
    ' quotient
    q = int(ytmp / 20)
    ' residue
    r = ytmp % 20
    ' adjust
    If r = 0 Then
      q = q - 1
    End If
    ' convert alphabet and store
    ThisComponent.Sheets(0).getCellByPosition(6,i).Value = char(79 - q)
  NEXT i
End Sub

　学習点ファイルには、受験番号、点数、ランクの３種の
　情報が格納されるようにしておきます。

　ここまでで、学力点と学習点のファイルが出来上がって
　いるので、２ファイルをマージ後、次のフォーマットで
　ワークシートを生成。



　合否判定と結果表示は、次のようにしました。

　受験番号、学力点、学習点を新しい列にコピー。
　学力点をキーに受験番号を並べ替え。
　学習点に対応した受験番号をランクに対応した
　列に転記。

　このアルゴリズムでは、受験番号が列の中で
　ランクに応じた学力点の高い者が、より上で
　並べられることになります。

　ランクに応じた受験番号を抽出するために一度コピー。

　受験番号を学力点に応じて並べ替えるには
　次のような操作になります。

　Ａ列、Ｇ列、Ｈ列をＪ列、Ｋ列、Ｌ列にコピー。




　連続している列にコピーすると、並べ替えを指示
　したときに、Ａ列からＨ列すべてに適用されます。
　それを避けるため、１列分空けます。

　学力点をキーに並べ替えるため、Ｋ列のどこかの
　セルをクリック。



　ツールバーの昇順、降順のいずれかのアイコンをクリック。



　降順のクリックで、学力点をキーに受験番号と学習点が
　並べ替えられていることを確認できます。



　ここまでできれば、学習点に応じて、受験番号を書き出すと
　合否判定の基礎データが完成します。

　同一の学習点をもつ受験番号を集める列へ、学習点の文字を書きます。



　受験番号を学習点の列にすべてコピー。



　コピーのマクロは、以下。

Sub Xcpy()
  Dim objS As Object
  Dim tmp As Integer
  Dim i As Integer
  Dim j As Integer
  ' LibreOffice Calc
  objS = ThisComponent.CurrentController.ActiveSheet
  ' loop
  FOR I =1 TO 501
    tmp = objS.getCellByPosition(0,I).Value
    For J = 0 To 12
      objS.getCellByPosition(10+J,I).Value = tmp
    Next J
  NEXT I
End Sub

　受験者数に応じて、外側のFOR文で使う最終値を
　入れ直すことにして使います。

　ランクに応じた、受験番号を抽出するため
　Ｌ列の受験者の学習点ランクと右にある列
　の最上行のランクが一致した受験番号だけ
　を残していきます。

　この処理を実行すると、次のようになります。



　対応するマクロは、以下。

Sub Xselect()
  Dim objS As Object
  Dim xstr As String
  Dim ystr As String
  Dim i As Integer
  Dim j As Integer
  ' LibreOffice Calc
  objS = ThisComponent.CurrentController.ActiveSheet
  ' loop
  For I=12 TO 24
    xstr = objS.getCellByPosition(I,0).String
    FOR J=1 TO 501
      ystr = objS.getCellByPosition(11,J).String
      IF ystr <> xstr Then
        objS.getCellByPosition( I ,J ).String = ""
      End If
    Next J
  NEXT I
End Sub

　２つの文字列が異なれば、対応セルに
　スペースを埋め込んでいます。

　受験番号を歯抜け状態から上にシフトします。



　対応するマクロは、以下。

Sub Xshift()
  Dim objS As Object
  Dim xstr As String
  Dim i As Integer
  Dim j As Integer
  Dim k As Integer
  ' LibreOffice Calc
  objS = ThisComponent.CurrentController.ActiveSheet
  ' loop
  For I=12 TO 24
    ' clear
    FOR J=1 TO 501
      objS.getCellByPosition(25,J).String = ""
    NEXT J 
    '  store
    K = 1  
    FOR J=1 TO 501
      ' get
      xstr = objS.getCellByPosition(I,J).String
      ' transfer
      IF xstr <> "" Then
        objS.getCellByPosition(25,K).String = xstr
        K = K + 1
      End If
    NEXT J
    ' copy
    FOR J=1 TO 501
      xstr = objS.getCellByPosition(25,J).String 
      objS.getCellByPosition(I,J).String = xstr
    Next J
  NEXT I
  ' clear
  FOR J=1 TO 501
    objS.getCellByPosition(25,J).String = ""
  NEXT J
End Sub

　使っていないＺ列に、受験番号を転記しておき
　歯抜け状態を解消します。この操作を実行後に
　Ｚ列の受験番号を、元の列に書き戻しています。

　合否判定は、定員が決まっているので、基本データを
　生成するまでが、spreadsheetの担当と割り切ります。
目次 前 次

inserted by FC2 system