教师平时分统计软件----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