教师平时分统计软件----Excel----VBA制作的。

这个暑假在家我用了三天的时间编了一个“教师平时分统计软件”，这个软件的功能很多，可以在上课的时候随机抽取名单点名，可以随机点名，可以统计平时作业平时分，可以统计考勤，统计课堂表现记录等！功能相当的齐全，对老师平时工作很有帮助！

下面我就将我用的VBA的代码公布出来，当然这些代码很糟糕，但是运行软件没问题，可以供初学VBA的同学共同学习。代码可能有点长，请大家认真看！

'=========================================================================

'学生名单表的代码：

Private Sub CommandButton1_Click()
Dim zjls As Integer
Dim xuehao, xingming As String
Call jcsjb("学生名单")
zjls = tj("学生名单")
Call 清除统计数据("点名名单", 1, 5)
Call 清除统计数据("上课名单", 1, 2)
Call 清除统计数据("考勤统计", 1, 2)
Call 清除统计数据("提问历史统计", 1, 2)
Call 清除统计数据("提交作业", 1, 2)
Call 清除统计数据("作业统计", 1, 2)
Call 清除统计数据("平时分统计", 1, 2)
For i = 1 To zjls
With Worksheets("学生名单")
xuehao = Trim(.Cells(i, 1).Value)
xingming = Trim(.Cells(i, 2).Value)
End With
With Worksheets("考勤统计")
.Cells(i, 1).Value = xuehao
.Cells(i, 2).Value = xingming
End With
With Worksheets("提问历史统计")
.Cells(i, 1).Value = xuehao
.Cells(i, 2).Value = xingming
End With
With Worksheets("提交作业")
.Cells(i, 1).Value = xuehao
.Cells(i, 2).Value = xingming
End With
With Worksheets("作业统计")
.Cells(i, 1).Value = xuehao
.Cells(i, 2).Value = xingming
End With
With Worksheets("平时分统计")
.Cells(i, 1).Value = xuehao
.Cells(i, 2).Value = xingming
End With
Next
End Sub
Private Sub CommandButton3_Click()
Dim renshu As Integer
Dim zrs As Integer
zrs = tj("学生名单") - 1
If Val(Trim(TextBox3.Text)) = 0 Or Val(Trim(TextBox3.Text)) > zrs Then
MsgBox "请输入点名的人数 " & Chr(13) & Chr(13) & Chr(13) & "人数必须大于0个小于" & zrs, vbOKOnly, "提醒"
Exit Sub
End If
Call 清除统计数据("点名名单", 1, 5)
renshu = Val(Trim(TextBox3.Text))
Call 点名(renshu)
Worksheets("点名名单").Activate
End Sub
Private Sub CommandButton5_Click()
Dim renshu As Integer
Worksheets("点名名单").Activate
Call 清除统计数据("点名名单", 1, 5)
renshu = Val(tj("学生名单")) - 1
Call 点名(renshu)
End Sub

‘======================================================================

'平时表现记录工作表的代码：

Private Sub CommandButton1_Click()
Call 平时表现
End Sub
Sub 平时表现()
Dim zjrs As Integer
Dim xingming, xuehao, contents, dj, time As String
zjrs = tj("平时表现记录")
xuehao = Trim(TextBox1.Text)
xingming = Trim(TextBox2.Text)
contents = Trim(TextBox3.Text)
If OptionButton1.Value = True Then
dj = "1′"
End If
If OptionButton2.Value = True Then
dj = "2′"
End If
If OptionButton3.Value = True Then
dj = "3′"
End If
If OptionButton4.Value = True Then
dj = "4′"
End If
If OptionButton5.Value = True Then
dj = "5′"
End If
Call rdjzf(xuehao, dj)
time = Trim(Now())
With Worksheets("平时表现记录")
.Cells(zjrs + 1, 1).Value = xuehao
.Cells(zjrs + 1, 2).Value = xingming
.Cells(zjrs + 1, 3).Value = dj
.Cells(zjrs + 1, 4).Value = time
.Cells(zjrs + 1, 5).Value = contents
End With
End Sub

Private Sub CommandButton2_Click()
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
End Sub
Private Sub TextBox1_Change()
Call dbclick
End Sub

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call dbclick
End Sub
Sub dbclick()
Dim xuehao, xuehao2, xingming2 As String
Dim jlzs As Integer
If TextBox1.Text = "" Then
TextBox2.Text = ""
CommandButton1.Enabled = False
Exit Sub
End If
xuehao = Trim(TextBox1.Text)
jlzs = tj("学生名单")
For i = 2 To jlzs
With Worksheets("学生名单")
xuehao2 = Trim(.Cells(i, 1).Value)
xingming2 = .Cells(i, 2).Value
End With
If xuehao = xuehao2 Then
TextBox2.Text = xingming2
CommandButton1.Enabled = True
Exit Sub
Else:
TextBox2.Text = ""
CommandButton1.Enabled = False
End If
Next
End Sub

'================================================================

'提问历史统计工作表的代码：

Private Sub CommandButton1_Click()
Dim hdzfs, hdpjfs, hdfs, maxf, minf, sumf, avgf As Double
Dim zjls As Integer
zjls = tj("提问历史统计")
maxf = 0
minf = 100
sumt = 0
sumf = 0
avgf = 0
hdzfs = InputBox("请输入您规定的上课回答问题在平时分中的分值！", "请输入回答问题总分数", 20)
If hdzfs = "" Then
Exit Sub
End If
hdpjfs = hdpjf(hdzfs, zjls)
For i = 2 To zjls
With Worksheets("提问历史统计")
hdfs = 0
hdfs = hdfs + Val(Trim(.Cells(i, 4))) * 3 + Val(Trim(.Cells(i, 5))) * 2 + Val(Trim(.Cells(i, 6))) * 1
.Cells(i, 7).Value = Round(hdfs * hdpjfs)
sumf = sumf + .Cells(i, 7).Value
If maxf < .Cells(i, 7).Value Then
maxf = .Cells(i, 7).Value
End If
If minf > .Cells(i, 7).Value Then
minf = .Cells(i, 7).Value
End If
.Cells(i, 3).Value = Val(Trim(.Cells(i, 4))) + Val(Trim(.Cells(i, 5))) + Val(Trim(.Cells(i, 6)))
sumt = sumt + Val(Trim(.Cells(i, 3).Value))
End With
Next
avgf = Round(sumf / zjls, 4)
TextBox4.Text = sumt
TextBox5.Text = avgf
TextBox6.Text = maxf
TextBox7.Text = minf
End Sub

'===========================================================================

'点名名单工作表的代码:

Function 添加考勤统计() As Boolean
Dim xuehao, xingming, time As String
Dim dmjl, kqjl, kqls, k As Integer
Dim cd, kk, qj As Integer
k = 2
dmjl = tj("点名名单")
kqjl = tj("考勤统计")
For i = 2 To dmjl - 1
With Worksheets("点名名单")
xuehao = .Cells(i, 1).Value
End With
With Worksheets("点名名单")
cd = .Cells(i, 3).Value
kk = .Cells(i, 4).Value
qj = .Cells(i, 5).Value
If (Val(cd) + Val(kk) + Val(qj)) > 1 Then
MsgBox "学号为: " & xuehao & " 的记录有问题。请注意查看！添加数据失败" & Chr(13) & Chr(13) & _
"该生的记录为：" & Chr(13) & " 迟到: " & cd & Chr(13) & " 旷课：" & kk & Chr(13) & " 请假： " & qj, vbOKOnly, "错误提示"
添加考勤统计 = False
.Cells(i, 3).Select
Exit Function
Else: 添加考勤统计 = True
End If
End With
Next
With Worksheets("点名名单")
time = .Cells(dmjl, 2).Value
End With
kqls = tjl("考勤统计", 1)
With Worksheets("考勤统计")
.Cells(1, kqls + 1).Value = time
End With
For i = 2 To dmjl - 1
With Worksheets("点名名单")
xuehao = .Cells(i, 1).Value
xingming = .Cells(i, 2).Value
End With
Do
With Worksheets("考勤统计")
If .Cells(k, 1).Value = xuehao Then
Exit Do
End If
End With
k = k + 1
If k > kqjl Then
MsgBox "数据有错误：有两种可能，一是点名名单有错，二是考勤名单的学号有错。" & Chr(13) & "请检查该学生 " _
& xingming & " 的学号。" & Chr(13) & "核实名单表和考勤统计表该学生的学号", vbOKOnly, "检查严重错误"
Call goback(i, "点名名单", "考勤统计")
Exit Function
End If
Loop Until False

With Worksheets("点名名单")
cd = .Cells(i, 3).Value
kk = .Cells(i, 4).Value
qj = .Cells(i, 5).Value
End With
With Worksheets("考勤统计")
If cd = 1 Then
.Cells(k, 3).Value = Val(.Cells(k, 3).Value) + cd
.Cells(k, kqls + 1).Value = "●"
End If
If kk = 1 Then
.Cells(k, 4).Value = Val((.Cells(k, 4).Value)) + kk
.Cells(k, kqls + 1).Value = "○"
End If
If qj = 1 Then
.Cells(k, 5).Value = Val((.Cells(k, 5).Value)) + qj
.Cells(k, kqls + 1).Value = "⊙"
End If
End With
Next
End Function

Sub 添加上课名单()
Dim dmrs, skrs, zrs, k As Integer
Dim xuehao As String
Dim cd, kk, qj As Integer
zrs = tj("学生名单")
dmrs = tj("点名名单")
skrs = 1
For i = 2 To zrs
With Worksheets("学生名单")
xuehao = .Cells(i, 1).Value
End With
k = 2
Do
If k > dmrs - 1 Then
With Worksheets("学生名单")
xuehao = .Cells(i, 1).Value
xingming = .Cells(i, 2).Value
End With
With Worksheets("上课名单")
skrs = skrs + 1
.Cells(skrs, 1).Value = xuehao
.Cells(skrs, 2).Value = xingming
End With
Exit Do
End If
With Worksheets("点名名单")
cd = Val(.Cells(k, 3).Value)
kk = Val(.Cells(k, 4).Value)
qj = Val(.Cells(k, 5).Value)
xuehao2 = .Cells(k, 1).Value
End With
If xuehao2 = xuehao Then
If (cd + kk + qj) = 0 Then
With Worksheets("学生名单")
xuehao = .Cells(i, 1).Value
xingming = .Cells(i, 2).Value
End With
With Worksheets("上课名单")
skrs = skrs + 1
.Cells(skrs, 1).Value = xuehao
.Cells(skrs, 2).Value = xingming
End With
Exit Do
Else: Exit Do
End If
End If
k = k + 1
Loop Until False
Next
Worksheets("上课名单").Activate
End Sub

Private Sub CommandButton1_Click()
If 添加考勤统计 = False Then
Exit Sub
End If
Call 添加考勤统计
Call 清除统计数据("上课名单", 1, 3)
Call 添加上课名单
Call 上课名单提问次数
End Sub

Private Sub CommandButton2_Click()
Call 清空点名名单
Worksheets("学生名单").Activate
End Sub

'===========================================================================

'提交作业工作表的代码：

Private Sub CommandButton1_Click()
Dim xuehao(), xingming(), jsstring As String
Dim k, zjls As Integer
k = 0
ReDim xuehao(k)
ReDim xingming(k)
zjls = tj("提交作业")
For i = 2 To zjls
With Worksheets("提交作业")
If Trim(.Cells(i, 3).Value) = "" Or Trim(.Cells(i, 3).Value) = "未交" Then
ReDim Preserve xuehao(UBound(xuehao) + 1)
ReDim Preserve xingming(UBound(xingming) + 1)
xuehao(UBound(xuehao)) = .Cells(i, 1).Value
xingming(UBound(xingming)) = .Cells(i, 2).Value
End If
End With
Next
For i = 1 To UBound(xuehao)
jsstring = jsstring & xuehao(i) & Space(5) & xingming(i) & Chr(13)
Next
If UBound(xuehao) > 0 Then
msg = MsgBox("选择确定键： 继续提交本次作业,没有数据的人当作未交作业！ " & Chr(13) & "选择取消键： 取消本次提交，检查数据 ！" _
& Chr(13) & Chr(13) & jsstring, vbOKCancel, "注意，有下列一些学生未交作业")
If msg = vbCancel Then
Exit Sub
End If
End If
For i = 2 To zjls
With Worksheets("提交作业")
If Trim(.Cells(i, 3).Value) = "" Then
.Cells(i, 3).Value = "未交"
End If
End With
Next
Call 作业提交
Worksheets("作业统计").Activate
End Sub

Private Sub CommandButton2_Click()
Call 添加作业
End Sub

Private Sub CommandButton3_Click()
Call 清除统计数据("提交作业", 3, 3)
End Sub

Private Sub TextBox1_Change()
Call dbclick
End Sub

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call dbclick
End Sub
Sub dbclick()
Dim xuehao, xuehao2, xingming2 As String
Dim jlzs As Integer
If TextBox1.Text = "" Then
TextBox2.Text = ""
CommandButton2.Enabled = False
Exit Sub
End If
xuehao = Trim(TextBox1.Text)
jlzs = tj("学生名单")
For i = 2 To jlzs
With Worksheets("学生名单")
xuehao2 = Trim(.Cells(i, 1).Value)
xingming2 = .Cells(i, 2).Value
End With
If xuehao = xuehao2 Then
TextBox2.Text = xingming2
CommandButton2.Enabled = True
Exit Sub
Else:
TextBox2.Text = ""
CommandButton2.Enabled = False
End If
Next
End Sub
Sub 添加作业()
Dim xuehao As String
Dim dj As String
xuehao = Trim(TextBox1.Text)
If Trim(TextBox2.Text) = "" Then
Call dbclick
If Trim(TextBox2.Text) = "" Then
MsgBox "学号输入有误，请重新输入！ ", vbOKOnly, "提醒"
Exit Sub
End If
End If
If OptionButton1.Value = True Then
dj = "优"
End If
If OptionButton2.Value = True Then
dj = "良"
End If
If OptionButton3.Value = True Then
dj = "中"
End If
If OptionButton4.Value = True Then
dj = "及格"
End If
If OptionButton5.Value = True Then
dj = "不及格"
End If
If OptionButton6.Value = True Then
dj = "未交"
End If
Call 添加作业记录(xuehao, dj)
End Sub

'=====================================================================

'上课名单工作表的代码：

Private Sub CommandButton1_Click()
Dim zjls As Integer
Dim xuehao, xingming As String
xuehao = Trim(TextBox1.Text)
xingming = Trim(TextBox2.Text)
If xingming = "" Then
MsgBox "在姓名的文本框中姓名为空！" _
& Chr(13) & "双击学号文本框，姓名将显示出来！", vbOKOnly, "注意提示 "
CommandButton1.Enabled = False
Exit Sub
End If
Call lsjr(xuehao, xingming, vbYes)
Call lstj(xuehao, vbYes) '向提问历史统计表添加数据
zjls = tj("上课名单")
For i = 2 To zjls '向上课名单添加数据，数据一致
With Worksheets("上课名单")
If xuehao = Trim(.Cells(i, 1).Value) Then
.Cells(i, 3).Value = Val(Trim(.Cells(i, 3))) + 1
.Cells(i, 1).Font.Bold = True
.Cells(i, 2).Font.Bold = True
Exit Sub
End If
End With
Next
End Sub

Private Sub CommandButton2_Click()
Call tiwen
End Sub

Sub tiwen()
Dim zrs As Integer
Dim id As Integer
Dim m As Integer
Worksheets("上课名单").Activate
zrs = tj("上课名单")
If zrs < 2 Then
MsgBox "上课名单的学生数据不存在，请先点名之后使用随机提问按钮", vbOKOnly, "错误操作"
Worksheets("点名名单").Activate
Exit Sub
End If
id = sjs(zrs)
xuehao = Sheets("上课名单").Cells(id, 1).Value
xingming = Sheets("上课名单").Cells(id, 2).Value
msg = MsgBox("请 " & xingming & " 同学回答问题" & Chr(13) & Chr(13) & "选择是： 回答非常满意" & Chr(13) & "选择否： 回答满意" _
& Chr(13) & "选择取消：回答不满意", vbYesNoCancel + 64, "随机提问")
Call lsjr(xuehao, xingming, msg)
Call lstj(xuehao, msg)
With Worksheets("上课名单")
.Cells(id, 3).Value = Val(.Cells(id, 3).Value) + 1
End With
End Sub

Private Sub TextBox1_Change()
Call dbclick
End Sub

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call dbclick
End Sub

Sub dbclick()
Dim xuehao, xuehao2, xingming2 As String
Dim jlzs As Integer
If TextBox1.Text = "" Then
TextBox2.Text = ""
CommandButton1.Enabled = False
Exit Sub
End If
xuehao = Trim(TextBox1.Text)
jlzs = tj("学生名单")
For i = 2 To jlzs
With Worksheets("学生名单")
xuehao2 = Trim(.Cells(i, 1).Value)
xingming2 = .Cells(i, 2).Value
End With
If xuehao = xuehao2 Then
TextBox2.Text = xingming2
CommandButton1.Enabled = True
Exit Sub
Else:
TextBox2.Text = ""
CommandButton1.Enabled = False
End If
Next
End Sub

'======================================================================

'平时分统计工作表的代码：

Private Sub CommandButton1_Click()
Call 考勤统计
End Sub
Private Sub CommandButton10_Click()
ThisWorkbook.Saved = False
ThisWorkbook.Close
End Sub
Sub 课堂回答问题统计()
Dim hudazf, avgf As Double
Dim zjls, maxr, minr As Integer
Dim hdpjfs As Double
Dim sumfs, sumt, hdfs As Integer
minf = 100
maxf = 0
hudazf = Val(Trim(TextBox4.Text))
If hudazf = 0 Then
ms = MsgBox("你输入的课堂回答问题总分数: 0 " & Chr(13) & Chr(13) & "按确定键 : 继续统计，课堂回答问题分全部为0分 ！" _
& Chr(13) & "按取消键 : 取消统计，添加数据", vbOKCancel, "警示")
If ms = vbCancel Then
Worksheets("平时分统计").Cells(1, 1).Select
Exit Sub
End If
End If
zjls = tj("平时分统计")
hdpjfs = hdpjf(hudazf, zjls)
For i = 2 To zjls
With Worksheets("提问历史统计")
hdfs = 0
hdfs = hdfs + Val(Trim(.Cells(i, 4))) * 3 + Val(Trim(.Cells(i, 5))) * 2 + Val(Trim(.Cells(i, 6))) * 1
.Cells(i, 7).Value = Round(hdfs * hdpjfs)
sumf = sumf + .Cells(i, 7).Value
.Cells(i, 3).Value = Val(Trim(.Cells(i, 4))) + Val(Trim(.Cells(i, 5))) + Val(Trim(.Cells(i, 6)))
sumt = sumt + Val(Trim(.Cells(i, 3).Value))
End With
With Worksheets("平时分统计")
.Cells(i, 4).Value = Round(hdfs * hdpjfs)
If maxf < .Cells(i, 4).Value Then
maxf = .Cells(i, 4).Value
End If
If minf > .Cells(i, 4).Value Then
minf = .Cells(i, 4).Value
End If
End With
Next
avgf = Round(sumf / zjls, 4)
TextBox9.Text = sumt
TextBox10.Text = avgf
TextBox11.Text = maxf
TextBox12.Text = minf
End Sub
Private Sub CommandButton2_Click()
Call 课堂回答问题统计
End Sub

Private Sub CommandButton3_Click()
Call 作业统计结果
End Sub
Sub 作业统计结果()
Dim zyzfs, maxr, minr, pjfs, zfs As Double
Dim zjls As Integer
maxr = 0
minr = 100
zjls = tj("平时分统计")
zyzfs = Val(Trim(TextBox5.Text))
For i = 2 To zjls
Call zyfs(i, zyzfs)
With Worksheets("平时分统计")
zfs = zfs + .Cells(i, 5).Value
If maxr < .Cells(i, 5).Value Then
maxr = .Cells(i, 5).Value
End If
If minr > .Cells(i, 5).Value Then
minr = .Cells(i, 5).Value
End If
End With
pjfs = Round(zfs / zjls, 4)
TextBox15.Text = pjfs
TextBox13.Text = maxr
TextBox14.Text = minr
Next
End Sub
Private Sub CommandButton4_Click()
Call 激活统计细节表("考勤统计")
End Sub

Private Sub CommandButton5_Click()
Call 激活统计细节表("提问历史统计")
End Sub

Private Sub CommandButton6_Click()
Call 激活统计细节表("作业统计")
End Sub

Private Sub CommandButton7_Click()
Call 平时表现统计结果
End Sub
Sub 平时表现统计结果()
Dim bxzf, maxr, djf, pjf As Double
Dim xingming As String
Dim zjls As Integer
pjf = 0#
maxr = 0#
bxzf = Val(Trim(TextBox1.Text))
If bxzf = 0 Then
ms = MsgBox("你输入的课外表现总分数: 0 " & Chr(13) & Chr(13) & "按确定键 : 取消统计，添加数据！" _
& Chr(13) & "按取消键 : 继续统计，课外表现分全部为0分", vbOKCancel, "警示")
If ms = vbOK Then
Worksheets("平时分统计").Cells(1, 1).Select
Exit Sub
Else: TextBox1.Text = 0
End If
End If
pjf = bxpjf(bxzf)
zjls = tj("平时分统计")
For i = 2 To zjls
With Worksheets("平时分统计")
djf = Val(Trim(.Cells(i, 12).Value))
.Cells(i, 6).Value = Round(djf * pjf)
If maxr < Val(Trim(.Cells(i, 6).Value)) Then
maxr = Val(Trim(.Cells(i, 6).Value))
xingming = .Cells(i, 2).Value
End If
End With
Next
TextBox19.Text = xingming
End Sub
Sub 考勤统计()
Dim cd, kk, qj, zf As Single
If Trim(TextBox3.Text) = "" Or Trim(TextBox3.Text) = 0 Then
If msg("考勤总分") = vbOK Then
Exit Sub
Else: TextBox3.Text = 0
End If
End If
If Trim(TextBox16.Text) = "" Then
If msg("迟到一次扣分") = vbOK Then
Worksheets("平时分统计").Cells(29, 1).Select
Exit Sub
Else: TextBox16.Text = 0
End If
End If
If Trim(TextBox17.Text) = "" Then
If msg("旷课一次扣分") = vbOK Then
Worksheets("平时分统计").Cells(29, 1).Select
Exit Sub
Else: TextBox17.Text = 0
End If
End If
If Trim(TextBox18.Text) = "" Then
If msg("请假一次扣分") = vbOK Then
Worksheets("平时分统计").Cells(29, 1).Select
Exit Sub
Else: TextBox18.Text = 0
End If
End If
cd = Val(Trim(TextBox16.Text))
kk = Val(Trim(TextBox17.Text))
qj = Val(Trim(TextBox18.Text))
zf = Val(Trim(TextBox3.Text))
Call 考勤分数统计(cd, kk, qj, zf)
TextBox8.Text = kqtj
TextBox2.Text = cdtj
TextBox6.Text = kktj
TextBox7.Text = qjtj
End Sub
Private Sub CommandButton8_Click()
Call 激活统计细节表("平时表现记录")
End Sub
Function msg(lb)
msg = MsgBox("你忘了输 " & lb & " 数据，请将数据填写完整之后统计！" & Chr(13) & Chr(13) & "按确定键 : 取消统计运行，添加数据！" _
& Chr(13) & "按取消键 : 继续统计，" & lb & "为0分", vbOKCancel, "数据不完整提醒")
End Function
Function 检测空值和零值() As Boolean
If Trim(TextBox3.Text) = "" Then
If msg("考勤总分") = vbOK Then
检测空值和零值 = True
Exit Function
Else: TextBox3.Text = 0
End If
End If
If Trim(TextBox16.Text) = "" Then
If msg("迟到一次扣分") = vbOK Then
Worksheets("平时分统计").Cells(29, 1).Select
检测空值和零值 = True
Exit Function
Else: TextBox16.Text = 0
End If
End If
If Trim(TextBox17.Text) = "" Then
If msg("旷课一次扣分") = vbOK Then
Worksheets("平时分统计").Cells(29, 1).Select
检测空值和零值 = True
Exit Function
Else: TextBox17.Text = 0
End If
End If
If Trim(TextBox18.Text) = "" Then
If msg("请假一次扣分") = vbOK Then
Worksheets("平时分统计").Cells(29, 1).Select
检测空值和零值 = True
Exit Function
Else: TextBox18.Text = 0
End If
End If
If Trim(TextBox4.Text) = "" Then
If msg("课堂表现总分") = vbOK Then
检测空值和零值 = True
Exit Function
Else: TextBox4.Text = 0
End If
End If
If Trim(TextBox5.Text) = "" Then
If msg("作 业 总 分") = vbOK Then
检测空值和零值 = True
Exit Function
Else: TextBox5.Text = 0
End If
End If
If Trim(TextBox1.Text) = "" Then
If msg("课外表现总分") = vbOK Then
检测空值和零值 = True
Exit Function
Else: TextBox1.Text = 0
End If
End If
End Function
Private Sub CommandButton9_Click()
Dim 考勤_sum, 课堂_sum, 作业_sum, 表现_sum, 平时分_sum As Integer
Dim 总记录数 As Integer
If 检测空值和零值 = True Then
Exit Sub
End If
Call 考勤统计
Call 课堂回答问题统计
Call 作业统计结果
Call 平时表现统计结果

总记录数 = tj("学生名单")
For i = 2 To 总记录数
With Worksheets("平时分统计")
.Cells(i, 7).Value = .Cells(i, 3).Value + .Cells(i, 4).Value + .Cells(i, 5).Value + .Cells(i, 6).Value
平时分_sum = 平时分_sum + .Cells(i, 7).Value
考勤_sum = 考勤_sum + .Cells(i, 3).Value
课堂_sum = 课堂_sum + .Cells(i, 4).Value
作业_sum = 作业_sum + .Cells(i, 5).Value
表现_sum = 表现_sum + .Cells(i, 6).Value
End With
Next
TextBox20.Text = Round(考勤_sum / 总记录数, 2)
TextBox21.Text = Round(课堂_sum / 总记录数, 2)
TextBox22.Text = Round(作业_sum / 总记录数, 2)
TextBox23.Text = Round(表现_sum / 总记录数, 2)
TextBox24.Text = Round(平时分_sum / 总记录数, 2)
End Sub

'======================================================================

'下面是几个模块的代码：

'=======================================================================

'第一个模块的代码：

Sub auto_open()

'MsgBox "次工作簿每5钟将自动保存一次。", vbInformation, "提醒"
UserForm1.Show 0
' Call runtimer
Call rununload
End Sub
Sub rununload()
Application.OnTime Now + TimeValue("00:00:2"), "卸载"
End Sub
'Sub runtimer()
' Application.OnTime Now + TimeValue("00:10:00"), "saveit"
'End Sub
'Sub saveit()
'ActiveWorkbook.Save
'Call runtimer
'End Sub
Sub 卸载()
unload UserForm1
End Sub
'===============================================================================================================
Public Function tj(lb) As Integer
Dim k As Integer
k = 2
Do
Set myR = Sheets(lb).Cells(k, 1)
If Trim(myR.Value) = "" Then '出现空记录
Exit Do
End If
k = k + 1
Loop Until False
tj = k - 1
End Function
Public Function tjl(lb, row As Integer) As Integer
Dim k As Integer
k = 1
Do
Set myR = Sheets(lb).Cells(row, k)
If Trim(myR.Value) = "" Then Exit Do
k = k + 1
Loop Until False
tjl = k - 1
End Function
Public Function sjs(zrs) As Integer
Dim flag As Boolean
flag = False
Randomize Timer '随机数种子
Do
x = Int(Rnd * zrs) + 1
sjs = x
flag = zntw(x, zrs)
If x = 1 Then flag = False
Loop Until flag
End Function
Sub lsjr(xuehao, xingming, msg)
Dim k As String
Dim t As String
t = Now()
k = tj("提问历史纪录") + 1
With Worksheets("提问历史纪录")
.Cells(k, 1).Value = k - 1
.Cells(k, 2).Value = xuehao
.Cells(k, 3).Value = xingming
.Cells(k, 7).Value = t
If msg = vbYes Then .Cells(k, 4).Value = 1
If msg = vbNo Then .Cells(k, 5).Value = 1
If msg = vbCancel Then .Cells(k, 6).Value = 1
End With
End Sub
Sub lstj(xuehao, msg)
Dim zjls As Integer
Dim xuehao2 As String
zjls = tj("提问历史统计")
For i = 2 To zjls
With Worksheets("提问历史统计")
xuehao2 = Trim(.Cells(i, 1).Value)
If xuehao = xuehao2 Then
If msg = vbYes Then .Cells(i, 4).Value = Val(Trim(.Cells(i, 4).Value)) + 1
If msg = vbNo Then .Cells(i, 5).Value = Val(Trim(.Cells(i, 5).Value)) + 1
If msg = vbCancel Then .Cells(i, 6).Value = Val(Trim(.Cells(i, 6).Value)) + 1
.Cells(i, 3).Value = Val(Trim(.Cells(i, 3))) + 1
Exit Sub
End If
End With
Next
End Sub
Public Function zntw(x, zrs) As Boolean
Dim max, min As Integer
Dim m As Integer
min = 10000
max = 0
With Worksheets("上课名单")
For i = 2 To zrs
If min > Int(Val((Trim(.Cells(i, 15).Value)))) Then
min = Int(Val((Trim(.Cells(i, 15).Value))))
End If
If max < Int(Val((Trim(.Cells(i, 15).Value)))) Then
max = Int(Val((Trim(.Cells(i, 15).Value))))
End If
Next
If max = min Then max = max + 1
m = Int(Val((Trim(.Cells(x, 15).Value))))
End With
If m = max Then
zntw = False
Else: zntw = True
End If
End Function
Sub 清除统计数据(lb, start, last)
zjls = tj(lb)
With Worksheets(lb)
For i = 2 To zjls
For j = start To last
.Cells(i, j).ClearContents
.Cells(i, j).Font.Bold = False
.Cells(i, j).Font.Bold = False
Next j
Next i
End With
End Sub
Sub 清除考勤统计表()
Dim zjls As Integer
zjls = tj("考勤统计")
zjlcs = tjl("考勤统计", 1)
With Worksheets("考勤统计")
For i = 1 To zjls
For j = 6 To zjlcs
.Cells(i, j).ClearContents
Next j
Next i
End With
End Sub
Sub 清除作业统计表()
Dim zjls As Integer
zjls = tj("作业统计")
zjlcs = tjl("作业统计", 1)
With Worksheets("作业统计")
For i = 1 To zjls
For j = 9 To zjlcs
.Cells(i, j).ClearContents
Next j
Next i
End With
End Sub
Sub 清空点名名单()
Dim zjls, t, nt As Integer
Dim n As String
zjls = tj("点名名单")
With Worksheets("点名名单")
t = Val(Mid(Trim(Cells(zjls, 2).Value), 8, 2))
n = Now()
nt = Val(Mid(Trim(n), 8, 2))
If nt = t Then
msg = MsgBox("确定要清空这次点名名单的数据吗", vbOKCancel, "提醒")
Else: msg = MsgBox("确定要清空上次点名名单的数据吗", vbOKCancel, "提醒")
End If
End With
If msg = vbCancel Then Exit Sub
Call 清除统计数据("点名名单", 1, 5)
End Sub
Sub 初始化所有表格()
Call 清除统计数据("学生名单", 1, 2)
Call 清除统计数据("点名名单", 1, 5)
Call 清除统计数据("上课名单", 1, 3)
Call 清除考勤统计表
Call 清除统计数据("考勤统计", 1, 5)
Call 清除统计数据("提问历史纪录", 1, 7)
Call 清除统计数据("提问历史统计", 1, 7)
Call 清除统计数据("提交作业", 1, 3)
Call 清除作业统计表
Call 清除统计数据("作业统计", 1, 8)
Call 清除统计数据("平时表现记录", 1, 5)
Call 清除统计数据("平时分统计", 1, 7)
End Sub

'=======================================================================

'第二个模块的代码：

Dim mingdan() As Integer

Sub 点名名单(zrs, renshu)
Randomize Timer '随机数种子
k = 1
Do While k <= renshu
x = Int(Rnd * zrs) + 1
cf = 0
While (x = 1)
x = Int(Rnd * zrs) + 1
Wend
For m = 1 To k - 1
If mingdan(m) = x Then cf = 1 '有重复放弃
Next
If cf = 0 Then '不重复，有效
mingdan(k) = x: k = k + 1
End If
Loop
End Sub

Sub 点名(renshu As Integer)
ReDim mingdan(renshu)
Dim zrs, k, t As Integer
Dim xuehao As String
Dim xingming As String
Dim time As String
zrs = tj("学生名单")
Call 点名名单(zrs, renshu)
For i = 1 To renshu - 1
t = mingdan(i)
p = i
For j = i + 1 To renshu
If mingdan(j) < t Then
t = mingdan(j)
p = j
End If
Next
t = mingdan(p)
mingdan(p) = mingdan(i)
mingdan(i) = t
Next
For i = 1 To renshu
k = mingdan(i)
With Worksheets("学生名单")
xuehao = .Cells(k, 1).Value
xingming = .Cells(k, 2).Value
End With
With Worksheets("点名名单")
.Cells(i + 1, 1).Value = xuehao
.Cells(i + 1, 2).Value = xingming
End With
Next
time = Now()
With Worksheets("点名名单")
.Cells(renshu + 2, 1).Value = "点名时间"
.Cells(renshu + 2, 2).Value = time
End With
End Sub
Sub goback(j, lb1, lb2)
Dim xuehao As String
Dim dmjl, kqjl, kqls, k As Integer
Dim cd, kk, qj As Integer
k = 2
dmjl = tj(lb1)
kqjl = tj(lb2)
kqls = tjl(lb2, 1)
With Worksheets(lb2)
.Cells(1, kqls).Value = ""
End With
For i = 2 To j - 1
With Worksheets(lb1)
xuehao = .Cells(i, 1).Value
End With
Do
With Worksheets(lb2)
If .Cells(k, 1).Value = xuehao Then
Exit Do
End If
k = k + 1
End With
Loop Until False
With Worksheets(lb1)
cd = .Cells(i, 3).Value
kk = .Cells(i, 4).Value
qj = .Cells(i, 5).Value
End With
With Worksheets(lb2)
.Cells(k, 3).Value = .Cells(k, 3).Value - cd
.Cells(k, 4).Value = .Cells(k, 4).Value - kk
.Cells(k, 5).Value = .Cells(k, 5).Value - qj
If cd = 1 Then
.Cells(k, kqls).Value = ""
End If
If kk = 1 Then
.Cells(k, kqls).Value = ""
End If
If qj = 1 Then
.Cells(k, kqls).Value = ""
End If
End With
k = k + 1
Next
End Sub

Sub 上课名单提问次数()
Dim zrs, zrst, k As Integer
Dim xuehao As String
Dim twcs As Integer
zrs = tj("上课名单")
zrst = tj("提问历史统计")
For i = 2 To zrs
With Worksheets("上课名单")
xuehao = .Cells(i, 1).Value
End With
k = 2
Do
With Worksheets("提问历史统计")
xuehao2 = .Cells(k, 1).Value
twcs = .Cells(k, 3).Value
End With
If xuehao2 = xuehao Then
With Worksheets("上课名单")
.Cells(i, 3).Value = twcs
End With
Exit Do
End If
k = k + 1
If k > zrst Then
Exit Do
End If
Loop Until False
Next
End Sub

Sub jcsjb(lb)
Dim k, t As Integer
Dim xuehao As String
Dim flag As Boolean
t = 0
k = 2
Do
flag = True
With Worksheets(lb)
xuehao = Trim(.Cells(k, 1).Value)
If xuehao = "" Then '出现空记录
t = t + 1
End If
k = k + 1
xuehao = Trim(.Cells(k, 1).Value)
While t = 6
Exit Do
Wend
While t = 5 And flag = True
If xuehao <> "" Then
MsgBox lb & "数据表在第" & k - 1 & "行出现空记录，请检查修改后。" & "保证数据表中间不出现空记录后才能运行此软件。" _
, vbOKOnly, "数据表记录有误"
Exit Sub
Else: flag = False
End If
Wend
While t = 4 And flag = True
If xuehao <> "" Then
MsgBox lb & "数据表在第" & k - 1 & "行出现空记录，请检查修改后。" & "保证数据表中间不出现空记录后才能运行此软件。" _
, vbOKOnly, "数据表记录有误"
Exit Sub
Else: flag = False
End If
Wend
While t = 3 And flag = True
If xuehao <> "" Then
MsgBox lb & "数据表在第" & k - 1 & "行出现空记录，请检查修改后。" & "保证数据表中间不出现空记录后才能运行此软件。" _
, vbOKOnly, "数据表记录有误"
Exit Sub
Else: flag = False
End If
Wend
While t = 2 And flag = True
If xuehao <> "" Then
MsgBox lb & "数据表在第" & k - 1 & "行出现空记录，请检查修改后。" & "保证数据表中间不出现空记录后才能运行此软件。" _
, vbOKOnly, "数据表记录有误"
Exit Sub
Else: flag = False
End If
Wend
While t = 1 And flag = True
If xuehao <> "" Then
msg = MsgBox(lb & "数据表在第" & k - 1 & "行出现空记录，请检查修改后。" & "保证数据表中间不出现空记录后才能运行此软件。" _
, vbOKOnly, "数据表记录有误")
If msg = vbOK Then
Exit Sub
End If
Else: flag = False
End If
Wend
End With
Loop Until False
End Sub

'========================================================================

'第三个模块的代码：

Dim time As String
Sub 添加作业记录(xuehao, dj)
Dim zjls, i As Integer
Dim xuehao2 As String
zjls = tj("提交作业")
i = 2
Do
With Worksheets("提交作业")
xuehao2 = Trim(.Cells(i, 1).Value)
If xuehao = xuehao2 Then
If Trim(.Cells(i, 3).Value) <> "" Then
msg = MsgBox("该学生的作业记录上有数据" & Chr(13) & "是否覆盖上面的数据?" & Chr(13) & Chr(13) & Chr(13) _
& "选择是：覆盖数据" & Chr(13) & "选择否：取消添加", vbYesNo, "提醒")
If msg = vbYes Then
.Cells(i, 3).Value = dj
Exit Sub
Else: Exit Sub
End If
Else
.Cells(i, 3).Value = dj
Exit Sub
End If
End If
End With
i = i + 1
If i > zjls Then
MsgBox " 该生不存在列表里面，请检查后再添加！", vbOKOnly, "错误提醒"
Exit Sub
End If
Loop Until False
End Sub
Sub 作业提交()
Dim zjls, ls As Integer
Dim dj As String
zjls = tj("提交作业")
time = Now()
ls = tjl("作业统计", 1)
With Worksheets("作业统计")
.Cells(1, ls + 1).Value = time
End With
For i = 2 To zjls
With Worksheets("提交作业")
dj = .Cells(i, 3).Value
End With
With Worksheets("作业统计")
.Cells(i, ls + 1).Value = dj
If dj = "优" Then
.Cells(i, 3).Value = .Cells(i, 3).Value + 1
End If
If dj = "良" Then
.Cells(i, 4).Value = .Cells(i, 4).Value + 1
End If
If dj = "中" Then
.Cells(i, 5).Value = .Cells(i, 5).Value + 1
End If
If dj = "及格" Then
.Cells(i, 6).Value = .Cells(i, 6).Value + 1
End If
If dj = "不及格" Then
.Cells(i, 7).Value = .Cells(i, 7).Value + 1
End If
If dj = "未交" Then
.Cells(i, 8).Value = .Cells(i, 8).Value + 1
End If
End With
Next
End Sub

'==========================================================================

'第四个模块的代码：

Public cdtjs, kktjs, qjtjs, kqtjnumber As Integer
Sub 考勤分数统计(cd, kk, qj, zf)
Dim zjls As Integer
Dim code As Single
kqtjnumber = tjl("考勤统计", 1) - 5
zjls = tj("考勤统计")
cdtjs = 0: kktjs = 0: qjtjs = 0
For i = 2 To zjls
With Worksheets("考勤统计")
cdtjs = cdtjs + Val(Trim(.Cells(i, 3).Value))
kktjs = kktjs + Val(Trim(.Cells(i, 4).Value))
qjtjs = qjtjs + Val(Trim(.Cells(i, 5).Value))
code = zf - Val(Trim(.Cells(i, 3).Value)) * cd - Val(Trim(.Cells(i, 4).Value)) * kk - Val(Trim(.Cells(i, 5).Value)) * qj
End With
With Worksheets("平时分统计")
If code > 0 Then
.Cells(i, 3).Value = Round(code)
Else: .Cells(i, 3).Value = 0
End If
End With
Next
End Sub
Function cdtj()
cdtj = cdtjs
End Function
Function kktj()
kktj = kktjs
End Function
Function qjtj()
qjtj = qjtjs
End Function
Function kqtj()
kqtj = kqtjnumber
End Function
Sub 激活统计细节表(lb)
Worksheets(lb).Activate
Worksheets(lb).Cells(1, 1).Select
End Sub
Public Function bxpjf(bxzf) As Double
Dim zjrs As Integer
Dim rdjf As Double
rdjf = 0#
zjrs = tj("平时分统计")
With Worksheets("平时分统计")
For i = 2 To zjrs
If rdjf < Val(Trim(.Cells(i, 12).Value)) Then
rdjf = Val(Trim(.Cells(i, 12).Value))
End If
Next
If rdjf = 0 Then
bxpjf = 0#
Exit Function
End If
bxpjf = bxzf / rdjf
End With
End Function

Public Function djf(dj) As Integer
Select Case dj
Case "1′"
djf = 1
Case "2′"
djf = 2
Case "3′"
djf = 3
Case "4′"
djf = 4
Case "5′"
djf = 5
Case "未交"
djf = -1
Case "不及格"
djf = 0
Case "及格"
djf = 1
Case "中"
djf = 2
Case "良"
djf = 3
Case "优"
djf = 4
End Select
End Function
Sub rdjzf(xuehao, dj)
Dim zjrs, dengjifen, i As Integer
zjrs = tj("平时分统计")
dengjifen = djf(dj)
i = 2
Do
With Worksheets("平时分统计")
If xuehao = Trim(.Cells(i, 1).Value) Then
.Cells(i, 12).Value = .Cells(i, 12).Value + dengjifen
Exit Do
End If
End With
i = i + 1
If i > zjrs Then
MsgBox "学号输入有误！，请重新输过！", vbOKOnly, "错误提醒"
Exit Sub
End If
Loop Until False
End Sub
Function zypjf(zyzf) As Double
Dim zjls, zs As Integer
zs = tjl("作业统计", 1) - 8
If zs = 0 Then
zypjf = 0
Exit Function
End If
zf = djf("优")
zypjf = zyzf / (zs * zf)
End Function
Sub zyfs(i, zyzfs)
Dim zdjfs, zyzf As Integer
Dim sumf As Single
zyzf = zyzfs
zdjfs = 0
With Worksheets("作业统计")
djy = .Cells(i, 3).Value * djf("优")
djl = .Cells(i, 4).Value * djf("良")
djz = .Cells(i, 5).Value * djf("中")
djjg = .Cells(i, 6).Value * djf("及格")
djbjg = .Cells(i, 7).Value * djf("不及格")
djwj = .Cells(i, 8).Value * djf("未交")
zdjfs = djy + djl + djz + djjg + djbjg + djwj
End With
With Worksheets("平时分统计")
sumf = zdjfs * zypjf(zyzf)
If sumf > 0 Then
.Cells(i, 5).Value = Round(sumf)
Else: .Cells(i, 5).Value = 0
End If
End With
End Sub
Function hdpjf(huidazf, zjls) As Double
Dim zdjs, maxr As Integer
Dim sumf As Double
If huidazf = "" Then
huidazf = 0
End If
sumf = huidazf
maxr = 0
For i = 2 To zjls
With Worksheets("提问历史统计")
zdjs = Val(Trim(.Cells(i, 4).Value)) * 3
zdjs = zdjs + Val(Trim(.Cells(i, 5).Value)) * 2
zdjs = zdjs + Val(Trim(.Cells(i, 6).Value)) * 1
End With
If maxr < zdjs Then
maxr = zdjs
End If
Next
If maxr = 0 Then
hdpjf = 0#
Exit Function
End If
hdpjf = sumf / maxr
End Function

’===========================================================================

上面就是个软件的所有的代码，当然，你要从我的资源里下载这个软件，然后再看我这些代码。