|
|
Sub 算成绩()
m = InputBox("请输入年级如1、2、3、4、5、6") '记录年级
Dim xx(1 To 9) As String
xx(2) = "兴": xx(3) = "东": xx(4) = "西": xx(5) = "峪": xx(6) = "普": xx(7) = "尧": xx(8) = "苏": xx(9) = "后"
If m < 5 Then
xx(1) = "南"
Else
xx(1) = "南1"
xx(8) = "南2"
End If
Dim xxhz(1 To 9) As String
xxhz(2) = "兴中": xxhz(3) = "东风": xxhz(4) = "西沟": xxhz(5) = "峪头"
xxhz(6) = "普乐塬": xxhz(7) = "尧场": xxhz(8) = "苏家坡": xxhz(9) = "后沟"
If m < 5 Then
xxhz(1) = "南村"
Else
xxhz(1) = "南1"
xxhz(8) = "南2"
End If
Dim kmb(1 To 3) As String
kmb(1) = "语": kmb(2) = "数": kmb(3) = "英"
If m < 5 Then
xxs = 9
Else
xxs = 8
End If
For q = 1 To xxs
Sheets(xx(q)).Activate
n = Application.WorksheetFunction.CountA(Range("A2: A60")) - 11 '记录考试人数
'计算成绩
l = Application.WorksheetFunction.Match("语文", Range("a2:e2"), 0) '记录"语文"所在列数
ywzf = Application.WorksheetFunction.Sum(Range(Cells(3, l), Cells(n + 2, l))) '语文总分
sxzf = Application.WorksheetFunction.Sum(Range(Cells(3, l + 1), Cells(n + 2, l + 1))) '数学总分
ywjg = Application.WorksheetFunction.CountIf(Range(Cells(3, l), Cells(n + 2, l)), ">59") '语文及格人数
sxjg = Application.WorksheetFunction.CountIf(Range(Cells(3, l + 1), Cells(n + 2, l + 1)), ">59") '数学及格人数
ywyx = Application.WorksheetFunction.CountIf(Range(Cells(3, l), Cells(n + 2, l)), ">79") '语文优秀人数
sxyx = Application.WorksheetFunction.CountIf(Range(Cells(3, l + 1), Cells(n + 2, l + 1)), ">79") '数学优秀人数
If m > 2 Then
yyzf = Application.WorksheetFunction.Sum(Range(Cells(3, l + 2), Cells(n + 2, l + 2))) '英语总分
yyjg = Application.WorksheetFunction.CountIf(Range(Cells(3, l + 2), Cells(n + 2, l + 2)), ">59") '英语及格人数
yyyx = Application.WorksheetFunction.CountIf(Range(Cells(3, l + 2), Cells(n + 2, l + 2)), ">79") '英语优秀人数
End If
'在成绩单上输出成绩
Cells(n + 3, l) = ywzf: Cells(n + 3, l + 1) = sxzf '语文、数学总分
Cells(n + 4, l) = Round(ywzf / n, 2) '语文、数学均分
Cells(n + 4, l + 1) = Round(sxzf / n, 2)
Cells(n + 5, l) = Round(Cells(n + 4, l) * 0.6, 2) '语文、数学均分折分
Cells(n + 5, l + 1) = Round(Cells(n + 4, l + 1) * 0.6, 2)
Cells(n + 6, l) = ywjg: Cells(n + 6, l + 1) = sxjg '语文、数学及格人数
Cells(n + 7, l) = Round(ywjg / n * 100, 2) '语文、数学及格率
Cells(n + 7, l + 1) = Round(sxjg / n * 100, 2)
Cells(n + 8, l) = Round(Cells(n + 7, l) * 0.25, 2) '语文、数学及格率折分
Cells(n + 8, l + 1) = Round(Cells(n + 7, l + 1) * 0.25, 2)
Cells(n + 9, l) = ywyx: Cells(n + 9, l + 1) = sxyx '语文、数学优秀人数
Cells(n + 10, l) = Round(ywyx / n * 100, 2) '语文、数学优秀率
Cells(n + 10, l + 1) = Round(sxyx / n * 100, 2)
Cells(n + 11, l) = Round(Cells(n + 10, l) * 0.15, 2) '语文、数学优秀率折分
Cells(n + 11, l + 1) = Round(Cells(n + 10, l + 1) * 0.15, 2)
Cells(n + 12, l) = Cells(n + 5, l) + Cells(n + 8, l) + Cells(n + 11, l) '语文、数学积分
Cells(n + 12, l + 1) = Cells(n + 5, l + 1) + Cells(n + 8, l + 1) + Cells(n + 11, l + 1)
If m > 2 Then '英语科
Cells(n + 3, l + 2) = yyzf
Cells(n + 4, l + 2) = Round(yyzf / n, 2)
Cells(n + 5, l + 2) = Round(Cells(n + 4, l + 2) * 0.6, 2)
Cells(n + 6, l + 2) = yyjg
Cells(n + 7, l + 2) = Round(yyjg / n * 100, 2)
Cells(n + 8, l + 2) = Round(Cells(n + 7, l + 2) * 0.25, 2)
Cells(n + 9, l + 2) = yyyx
Cells(n + 10, l + 2) = Round(yyyx / n * 100, 2)
Cells(n + 11, l + 2) = Round(Cells(n + 10, l + 2) * 0.15, 2)
Cells(n + 12, l + 2) = Cells(n + 5, l + 2) + Cells(n + 8, l + 2) + Cells(n + 11, l + 2)
End If
'计算个人总分,统计合格人数
hg = 0
For i = 3 To n + 2
If m < 3 Then
Cells(i, l + 2) = Round(Cells(i, l) + Cells(i, l + 1), 0)
If Cells(i, l) > 59 And Cells(i, l + 1) > 59 And Cells(i, l + 2) > 59 Then hg = hg + 1
Else
Cells(i, l + 3) = Round(Cells(i, l) + Cells(i, l + 1) + Cells(i, l + 2), 0)
If Cells(i, l) > 59 And Cells(i, l + 1) > 59 And Cells(i, l + 2) > 59 Then hg = hg + 1
End If
Next i
If m < 3 Then
Cells(n + 6, l + 2) = hg
Else
Cells(n + 6, l + 3) = hg
End If
'单科成绩汇总
If m < 3 Then
km = 2
Else
km = 3
End If
For gl = 1 To km
Sheets(kmb(gl)).Activate
kml = Application.WorksheetFunction.Match(xxhz(q), Range("a2:j2"), 0) '寻找学校所在列数
Cells(4, kml) = n
If gl = 1 Then Cells(5, kml) = ywzf
If gl = 2 Then Cells(5, kml) = sxzf
If gl = 3 Then Cells(5, kml) = yyzf
Cells(6, kml) = Round(Cells(5, kml) / n, 2)
If gl = 1 Then Cells(7, kml) = ywjg
If gl = 2 Then Cells(7, kml) = sxjg
If gl = 3 Then Cells(7, kml) = yyjg
Cells(8, kml) = Round(Cells(7, kml) / n * 100, 2)
If gl = 1 Then Cells(9, kml) = ywyx
If gl = 2 Then Cells(9, kml) = sxyx
If gl = 3 Then Cells(9, kml) = yyyx
Cells(10, kml) = Round(Cells(9, kml) / n * 100, 2)
Cells(11, kml) = Round(Cells(6, kml) * 0.6 + Cells(8, kml) * 0.25 + Cells(10, kml) * 0.15, 2)
Next gl
Next q
'单科汇总表计算
If m < 3 Then
km = 2
Else
km = 3
End If
For gl = 1 To km
Sheets(kmb(gl)).Activate
hjl = Application.WorksheetFunction.Match("合计", Range("a2:k2"), 0) '寻找合计列
Cells(4, hjl) = Application.WorksheetFunction.Sum(Range(Cells(4, 2), Cells(4, hjl - 1))) '合计人数
Cells(5, hjl) = Application.WorksheetFunction.Sum(Range(Cells(5, 2), Cells(5, hjl - 1))) '合计总分
Cells(6, hjl) = Round(Cells(5, hjl) / Cells(4, hjl), 2) '合计均分
Cells(7, hjl) = Application.WorksheetFunction.Sum(Range(Cells(7, 2), Cells(7, hjl - 1))) '合计及格人数
Cells(8, hjl) = Round(Cells(7, hjl) / Cells(4, hjl) * 100, 2) '合计及格率
Cells(9, hjl) = Application.WorksheetFunction.Sum(Range(Cells(9, 2), Cells(9, hjl - 1))) '合计优秀人数
Cells(10, hjl) = Round(Cells(9, hjl) / Cells(4, hjl) * 100, 2) '合计优秀率
Cells(11, hjl) = Round(Cells(6, hjl) * 0.6 + Cells(8, hjl) * 0.25 + Cells(10, hjl) * 0.15, 2) '学科积分
Cells(12, hjl) = "-"
Cells(13, hjl) = "-"
Cells(14, hjl) = "-"
For mc = 2 To hjl - 1
Cells(12, mc) = Round(Cells(11, mc) - Cells(11, hjl), 2) '与学科积分相差分
Cells(13, mc) = Round(Cells(11, mc) - Application.WorksheetFunction.Max(Range(Cells(11, 2), Cells(11, hjl - 1))), 2) '低于学科最高积分
Cells(14, mc) = Application.WorksheetFunction.Rank(Cells(11, mc), Range(Cells(11, 2), Cells(11, hjl - 1))) '名次
Next mc
Next gl
End Sub
成绩统计.rar
(134.16 KB, 下载次数: 127)
|
|
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-7-17 11:59
楼主