vba算成绩程序.doc

Sub 算成绩()m = InputBox(请输入年级如1、2、3、4、5、6) 记录年级Dim xx(1 To 8) As Stringxx(1) = 南村1: xx(2) = 南村2: xx(3) = 兴中: xx(4) = 东风: xx(5) = 西沟: xx(6) = 峪头: xx(7) = 普乐塬: xx(8) = 尧场Dim kmb(1 To 3) As Stringkmb(1) = 语: kmb(2) = 数: kmb(3) = 英For q = 1 To 8 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 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(xx(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 glNext qIf m 3 Then 单科汇总表计算km = 2Elsekm = 3End IfFor gl = 1 To kmSheets(kmb(gl).Activatehjl = 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 - 1Cells(12, mc) = Round(Cells(11, mc) - Cells(11, hjl), 2) 与学科积分