'#########################################################
'
' これはテスト問題を集計するExcelVBAプログラムです。
'
'　　　　　　　　CopyRight　久留米高専　　　中島　勝行
'#########################################################
Dim 正解(103), work(103), 成績表(101) As Integer
Sub csvread()
Dim d As Integer
'正解表のクリヤ
    Range("D8:DB17").Select
    Selection.ClearContents
'正解Read
    Open "f:\MCR\MCR.csv" For Input As #1
    For x = 1 To 103
        Cells(7, x + 3) = x
        Input #1, d
        Cells(4, x + 3) = d
        Cells(21, x + 3) = d
        work(x) = d
        正解(x) = d
    Next x
    Range("d8:w17").Select
    Selection.ClearContents
'目盛り書き
    For i = 1 To 10
        Cells(i + 7, 3) = i
    Next i
'正解展開
    Call tenkai(7)

'問題数取り出し
    Call bango(bangou)
    Cells(7, 3) = bangou
    mondaisu = bangou
'採点開始#################################################
    Range("c42:DB1000").Select
    Selection.ClearContents
    Range("d29:w38").Select
    Selection.ClearContents
For i = 1 To 999
    Cells(1, 9) = i - 1
    Range("D29:DB38").Select      '作業領域クリヤ
    Selection.ClearContents
        Cells(i + 41, 3) = ""
        Input #1, d    '空読みNL
        Count = 0
    For x = 1 To 103
        If EOF(1) Then GoTo syukei
        Cells(24, x + 3) = x '目盛り
        Input #1, d
        Cells(3, x + 3) = d  '作業領域に表示
        Cells(25, x + 3) = d  '学生答案イメージに表示
        work(x) = d
        If (正解(x) = d And x < (mondaisu + 1)) Then
            Cells(i + 41, x + 3) = "○"
            Count = Count + 1
        End If
    Next x
    Cells(i + 41, 106) = Count
    Cells(i + 41, 105) = Count / Cells(7, 3) * 100
    Call bango(bangou)
    Cells(28, 3) = bangou

    Call tenkai(28)
    Cells(i + 41, 104) = bangou
    Cells(i + 41, 3) = bangou
'ダブルマーク確認
'    MsgBox ("カード番号" & Str(i))
 Next i
syukei:
 Close #1

End Sub
Sub sort()
    Range("C42:Db1042").Select
    ActiveWindow.SmallScroll Down:=-993
    Selection.sort Key1:=Range("C42"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin
    'レベルマーキング　　１００点と６０以下
    For j = 1 To 999
        If Cells(j + 41, 104) = "" Then End
        If Cells(j + 41, 105) < 60 Then Cells(j + 41, 105).Interior.ColorIndex = 36 Else Cells(j + 41, 105).Interior.ColorIndex = xlNone
    Next j
End Sub
Sub bango(bangou)
    bai = 100
    bangou = 0
    For x = 101 To 103
        d = work(x)
        For i = 1 To 10
            v = d Mod 2
            If (v = 1 And i <> 10) Then bangou = bangou + i * bai
            d = d / 2
        Next i
        bai = bai / 10
    Next x
End Sub
Sub doublemarkerror(x, i)
    Cells(28, x + 3).Select
    With Selection.Interior
        .ColorIndex = 3
        .Pattern = xlSolid
    End With
    MsgBox ("２箇所にマーク" & Str(x) & "列" & "  行" & Str(i))
    Cells(28, x + 3).Select
    Selection.Interior.ColorIndex = 36
End Sub
Sub exe()
    myID = Shell("d:\MCR\MCR.exe", vbMaximizedFocus)
End Sub
Sub tenkai(gyou)
'bit展開
    For x = 1 To 103
        allready1 = 0
        d = work(x)
        For i = 1 To 10
            v = d Mod 2
             If v = 1 Then Cells(i + gyou, x + 3) = "■" Else Cells(i + gyou, x + 3) = ""
'マークのダブりチェック
           If (v = 1 And allready1 = 1) Then Call doublemarkerror(x, i)
            If v = 1 Then allready1 = 1
            d = d / 2
        Next i
    Next x
End Sub