⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frm_sjss2.frm

📁 一个用VB做的试卷分析评估系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
   
        Dim pppp
        pppp = "整体"
        If Q_nd <= 0.15 Then
           pppp = pppp + "试卷难度小"
        ElseIf Q_nd <= 0.2 Then
           pppp = pppp + "试卷难度较小"
        ElseIf Q_nd <= 0.35 Then
           pppp = pppp + "试卷难度适中"
        ElseIf Q_nd <= 0.4 Then
           pppp = pppp + "试卷难度较大"
        Else
           pppp = pppp + "试卷难度大"
        End If
        
        pppp = pppp + ","
        If D_qfd <= 0.24 Then
           pppp = pppp + "试卷区分度较小"
        ElseIf D_qfd <= 0.35 Then
           pppp = pppp + "试卷区分度适中"
        Else
           pppp = pppp + "试卷区分度大"
        End If
        pppp = pppp + "。"
        
        exl.Cells(22, 2).Value = pppp
       
     Else
        MsgBox "该试卷的没有成绩录入!", vbOK, "信息提示"
     End If
     RS_t.Close
   Else
       MsgBox "没有该试卷的信息!", vbOK, "信息提示"
   End If
   RS.Close
   
   
   
   
   '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
   
'   Set RS = DB.OpenRecordset("select * from shijuan  where  SJID=" + Str(DBGrid1.Columns(0)))
'
'   If RS.RecordCount > 0 Then
'     Set RS_t = DB.OpenRecordset("select * from stu_cj  where  SJID=" + Str(DBGrid1.Columns(0)))
'     If RS_t.RecordCount > 0 Then
'
'        'Dim i, j, total_ti As Integer
'        'Dim col_width As Double, fen  As Double, total_fen As Double
'        'Dim col As String
'        Dim f_Max As Double, f_Min As Double, f_Avg As Double
'        Dim Q_nd As Double, Q_nd_m(10) As Double '难度
'        Dim D_qfd As Double '区分度
'        Dim fens(10, 2) As Double
'        Dim fd(6)   '分段数组,即各分数段的人数,如fd(1)为90分以上的人
'        Dim Num As Integer
'        Dim p As Double
'        Dim tt(999) As Double  '每个学生的分数
'        Dim str_num As String
'        str_num = "一二三四五六七八九十"
'        f_Max = 0
'        f_Min = 99999
''        For i = 1 To 10
''           fens(i, 1) = -99999
''        Next i
'
'
'        For i = 1 To 6
'            fd(i) = 0
'        Next i
'
'
'        total_ti = RS.Fields("Total_ti").Value   '试卷总题数
'
'        '取每个人的分数,计算最高分,最低分,等。。
'        Do While Not RS_t.EOF
'            Num = Num + 1
'
'            For j = 1 To total_ti
'                fen = RS_t.Fields("T" + vba.trim(CStr(j))).Value
'                'If fen > fens(j, 2) Then fens(j, 2) = fen
'                fens(j, 2) = RS.Fields("T" + vba.trim(CStr(j))).Value
'                fens(j, 1) = fens(j, 1) + fen
'                tt(Num) = tt(Num) + fen
'            Next j
'           ' fens(j, 2) = fens(j, 1) / Num
'
'
'            If tt(Num) > f_Max Then f_Max = tt(Num)
'            If tt(Num) < f_Min Then f_Min = tt(Num)
'            total_fen = total_fen + tt(Num)
'
'            If tt(Num) >= 90 Then
'               fd(1) = fd(1) + 1
'            ElseIf tt(Num) >= 80 Then
'               fd(2) = fd(2) + 1
'            ElseIf tt(Num) >= 70 Then
'               fd(3) = fd(3) + 1
'            ElseIf tt(Num) >= 60 Then
'               fd(4) = fd(4) + 1
'            ElseIf tt(Num) >= 40 Then
'               fd(5) = fd(5) + 1
'            Else
'               fd(6) = fd(6) + 1
'            End If
'
'            RS_t.MoveNext
'        Loop
'
'        f_Avg = total_fen / Num  '平均分
'
'
'        '计算整个试卷的难度
'        For i = 1 To total_ti
'            Q_nd_m(i) = 1 - fens(i, 1) / Num / fens(i, 2)  '每道题的难度
'            Q_nd = Q_nd + CDbl(RS.Fields("t" + vba.trim(CStr(i))).Value) * Q_nd_m(i)
'        Next i
'        Q_nd = Q_nd / 100
'
'
'
'        '计算整个试卷的区分度
'        Dim sh As Double, sl As Double, n As Integer
'        p = Num * 27 / 100
'        n = CInt(Get_Point(p, -1)) + 1
'          '排序
'          For i = 1 To Num - 1
'             For j = 2 To Num
'                 If tt(i) > tt(j) Then
'                    p = tt(i)
'                    tt(i) = tt(j)
'                    tt(j) = p
'                 End If
'             Next j
'          Next i
'
'        For i = 1 To n
'           sh = sh + tt(Num + 1 - i)  '高分组
'           sl = sl + tt(i)            '低分组
'        Next i
'        D_qfd = (sh - sl) / (n * (f_Max - f_Min))
'
'
'
'
'        Set exl = New Excel.Application
'        exl.Workbooks.Add
'        exl.Visible = True
'
'
'        col_width = 10
'        For i = 1 To 7
'            exl.Columns(i).ColumnWidth = col_width
'            exl.Columns(i).HorizontalAlignment = xlCenter
'        Next
'
'        exl.Cells(1, 1).Value = "杭州师范学院" + RS.Fields("Institute").Value + RS.Fields("Year").Value + "学年第" + RS.Fields("Term").Value + "学期"
'        exl.Cells(2, 1).Value = "试卷质量指标分析表"
'        Call Unite_Exl_Col(1, 7, 1) '合并第一行
'        Call Unite_Exl_Col(1, 7, 2) '合并第二行
'        Rows("1:1").RowHeight = 36
'        Rows("2:2").RowHeight = 27.75
'
'        Rows("3:3").RowHeight = 23.25
'        exl.Cells(3, 1).Value = "班 级:"
'        exl.Cells(3, 2).Value = RS.Fields("Classes").Value
'        Call Unite_Exl_Col(2, 3, 3) '合并第三行的2,3两列
'
'        exl.Cells(3, 5).Value = "统计日期:"
'        exl.Cells(3, 6).Value = Date
'        Call Unite_Exl_Col(6, 7, 3) '合并第三行的5,6两列
'
'
'
'        Rows("4:4").RowHeight = 23.25
'        exl.Cells(4, 1).Value = "课程名称"
'        exl.Cells(4, 2).Value = "大学心理学"
'        Call Unite_Exl_Col(2, 3, 4) '合并第四三行的2,3两列
'
'        exl.Cells(4, 4).Value = "任课教师"
'        exl.Cells(4, 5).Value = RS.Fields("Teacher").Value
'        exl.Cells(4, 6).Value = "考试人数"
'        exl.Cells(4, 7).Value = RS.Fields("Stu_Num").Value
'
'
'        Rows("5:5").RowHeight = 23.25
'        exl.Cells(5, 1).Value = "分数统计"
'        exl.Cells(5, 2).Value = "最高分"
'        exl.Cells(5, 3).Value = f_Max
'        exl.Cells(5, 4).Value = "最低分"
'        exl.Cells(5, 5).Value = f_Min
'        exl.Cells(5, 6).Value = "平均分"
'        exl.Cells(5, 7).Value = f_Avg
'
'
'        exl.Cells(6, 1).Value = "试" + Chr(13) + Chr(10) + "卷" + Chr(13) + Chr(10) + "中" + Chr(13) + Chr(10) + "各" + Chr(13) + Chr(10) + "题" + Chr(13) + Chr(10) + "难" + Chr(13) + Chr(10) + "度"
'        Call Unite_Exl_Row(6, 16, 1) '合并第6到16行的第1列
'
'
'        exl.Cells(6, 2).Value = "题  号"
'        exl.Cells(6, 3).Value = "难度值"
'        exl.Cells(6, 4).Value = "难度 / 区分度系数参考标准"
'        Call Unite_Exl_Col(4, 7, 6) '合并第6行的4,5,6,7列
'
'        For i = 1 To 10
'            exl.Cells(6 + i, 2).Value = "第" + Mid(str_num, i, 1) + "题"
'        Next i
'
'        For i = 1 To total_ti
'          exl.Cells(6 + i, 3).Value = Get_Point(Q_nd_m(i), 2)
'        Next i
'
'        exl.Cells(17, 1).Value = "试卷整体" + Chr(13) + Chr(10) + "指  标"
'        Call Unite_Exl_Row(17, 18, 1) '合并第17到18行的第1列
'        exl.Cells(17, 2).Value = "难  度"
'        exl.Cells(17, 3).Value = Get_Point(Q_nd, 3)
'        exl.Cells(18, 2).Value = "区分度"
'        exl.Cells(18, 3).Value = Get_Point(D_qfd, 3)
'
'
'
'        exl.Cells(7, 4).Value = "难度系数参考标准"
'        exl.Cells(7, 4).HorizontalAlignment = xlLeft
'        Call Unite_Exl_Col(4, 7, 7)
'
'        exl.Cells(8, 4).Value = "难度值:"
'        exl.Cells(8, 4).HorizontalAlignment = xlLeft
'        Call Unite_Exl_Col(4, 7, 8)
'
'
'        exl.Cells(9, 4).Value = "0<q≤0.15"
'        Call Unite_Exl_Col(4, 5, 9)
'        exl.Cells(9, 6).Value = "试卷难度小"
'        Call Unite_Exl_Col(6, 7, 9)
'
'        exl.Cells(10, 4).Value = "0.15<q≤0.20"
'        Call Unite_Exl_Col(4, 5, 10)
'        exl.Cells(10, 6).Value = "试卷难度较小"
'        Call Unite_Exl_Col(6, 7, 10)
'
'        exl.Cells(11, 4).Value = "0.20<q≤0.35"
'        Call Unite_Exl_Col(4, 5, 11)
'        exl.Cells(11, 6).Value = "试卷难度适中"
'        Call Unite_Exl_Col(6, 7, 11)
'
'        exl.Cells(12, 4).Value = "0.35<q≤0.40"
'        Call Unite_Exl_Col(4, 5, 12)
'        exl.Cells(12, 6).Value = "试卷难度较大"
'        Call Unite_Exl_Col(6, 7, 12)
'
'        exl.Cells(13, 4).Value = "0.40<q≤1"
'        Call Unite_Exl_Col(4, 5, 13)
'        exl.Cells(13, 6).Value = "试卷难度大"
'        Call Unite_Exl_Col(6, 7, 13)
'
'
'
'
'        exl.Cells(14, 4).Value = "区分度系数参考标准:"
'        exl.Cells(14, 4).HorizontalAlignment = xlLeft
'        Call Unite_Exl_Col(4, 7, 14)
'
'        exl.Cells(15, 4).Value = "区分度值:"
'        exl.Cells(15, 4).HorizontalAlignment = xlLeft
'        Call Unite_Exl_Col(4, 7, 15)
'
'        exl.Cells(16, 4).Value = "0<D≤0.24"
'        Call Unite_Exl_Col(4, 5, 16)
'        exl.Cells(16, 6).Value = "试卷区分度较小"
'        Call Unite_Exl_Col(6, 7, 16)
'
'        exl.Cells(17, 4).Value = "0.24<D≤0.35"
'        Call Unite_Exl_Col(4, 5, 17)
'        exl.Cells(17, 6).Value = "试卷区分度适中"
'        Call Unite_Exl_Col(6, 7, 17)
'
'        exl.Cells(18, 4).Value = "0.35<D≤1"
'        Call Unite_Exl_Col(4, 5, 18)
'        exl.Cells(18, 6).Value = "试卷区分度大"
'        Call Unite_Exl_Col(6, 7, 18)
'
'
'
'        exl.Cells(19, 1).Value = "分段频数"
'        Call Unite_Exl_Row(19, 21, 1) '合并第19到21行的第1列
'        exl.Cells(19, 2).Value = "90分以上"
'        exl.Cells(19, 3).Value = "80-89分"
'        exl.Cells(19, 4).Value = "70-79分"
'        exl.Cells(19, 5).Value = "60-69分"
'        exl.Cells(19, 6).Value = "40-59分"
'        exl.Cells(19, 7).Value = "40分以下"
'
'        For i = 1 To 6
'            exl.Cells(20, i + 1).Value = fd(i)
'            p = fd(i) / Num * 100
'            exl.Cells(21, i + 1).Value = Get_Point(p, 2) + "%"
'        Next i
'
'
'
'
'        exl.Cells(22, 1).Value = "试卷分析" + Chr(13) + Chr(10) + "评  语"
'        Call Unite_Exl_Row(22, 27, 1) '合并第22到27行的第1列
'
'        Dim pppp
'        pppp = "整体"
'        If Q_nd <= 0.15 Then
'           pppp = pppp + "试卷难度小"
'        ElseIf Q_nd <= 0.2 Then
'           pppp = pppp + "试卷难度较小"
'        ElseIf Q_nd <= 0.35 Then
'           pppp = pppp + "试卷难度适中"
'        ElseIf Q_nd <= 0.4 Then
'           pppp = pppp + "试卷难度较大"
'        Else
'           pppp = pppp + "试卷难度大"
'        End If
'
'        pppp = pppp + ","
'        If D_qfd <= 0.24 Then
'           pppp = pppp + "试卷区分度较小"
'        ElseIf D_qfd <= 0.35 Then
'           pppp = pppp + "试卷区分度适中"
'        Else
'           pppp = pppp + "试卷区分度大"
'        End If
'        pppp = pppp + "。"
'
'        exl.Cells(22, 2).Value = pppp
'        Call Unite_Exl(22, 2, 27, 3)
'
'        exl.Cells(22, 4).Value = "分数分布" + Chr(13) + Chr(10) + "曲  线"
'        Call Unite_Exl_Row(22, 27, 4)
'
'
'
'
'     Else
'        MsgBox "该试卷的没有成绩录入!", vbOK, "信息提示"
'     End If
'     RS_t.Close
'   Else
'       MsgBox "没有该试卷的信息!", vbOK, "信息提示"
'   End If
'   RS.Close
   
   
   '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
End If
End Sub



⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -