接上篇,以下为VBA代码：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'以下求各班级各学科平均分
startclass = 1 '在表一检查班级名称的行序号初始值
endclass = 40 '在表一检查班级名称的行序号终止值
Startscan = 2 '在表四扫描学生数据之行号初始值
endscan = 2000 '在表四扫描学生数据之行号终止值
StartSubject = 3 '在表一要查找的科目列序号初始值
EndSubject = 8 '在表一要查找的科目列序号之终止值
total = 0 '总分
stunum = 0 '学生人数
TotalSheetIndex = 1 '汇总表序号
StuScorseSheetIndex = 4 '学生成绩表序号
If Target.Column = 13 And Target.Row = 4 Then
For m = StartSubject To EndSubject '求每个班级每个科目的总平均分
For k = startclass To endclass
calssname = Worksheets(TotalSheetIndex).Cells(k, 2).Value
If Len(calssname) <> 0 And calssname <> "班级" Then '检查班级号是否为空或其他非班级号字符
For h = Startscan To endscan
'检查班级相同
If Worksheets(StuScorseSheetIndex).Cells(h, 3).Value = Worksheets(TotalSheetIndex).Cells(k, 2).Value Then
total = total + Worksheets(StuScorseSheetIndex).Cells(h, 7 + (m - 3)).Value
If Len(Worksheets(StuScorseSheetIndex).Cells(h, 5).Value) <> 0 Then '检查学生姓名不为空
stunum = stunum + 1
End If
End If
Next
If total <> 0 And stunum <> 0 Then
Worksheets(TotalSheetIndex).Cells(k, m).Value = total / stunum
Else
Worksheets(TotalSheetIndex).Cells(k, m).Value = 0
End If
total = 0
stunum = 0
End If
Next
Next
'以下求各班级总平均分
For k = startclass To endclass
calssname = Worksheets(TotalSheetIndex).Cells(k, 2).Value
If Len(calssname) <> 0 And calssname <> "班级" Then '检查班级号是否为空或其他非班级号字符
For h = Startscan To endscan
'检查班级相同
If Worksheets(StuScorseSheetIndex).Cells(h, 3).Value = Worksheets(TotalSheetIndex).Cells(k, 2).Value Then
For m = StartSubject To EndSubject
total = total + Worksheets(StuScorseSheetIndex).Cells(h, 7 + (m - 3)).Value
Next
If Len(Worksheets(StuScorseSheetIndex).Cells(h, 5).Value) <> 0 Then '检查学生姓名不为空
stunum = stunum + 1
End If
End If
Next
If total <> 0 And stunum <> 0 Then
Worksheets(TotalSheetIndex).Cells(k, m).Value = total / stunum
Else
Worksheets(TotalSheetIndex).Cells(k, m).Value = 0
End If
total = 0
stunum = 0
End If
Next
End If
End Sub