下载文档原格式
用vba统计分析学生成绩（三率）根据全校（年级）学生成绩汇总表，按年级分班级对各学科参考人数、总分、平均分、及格人数、及格率、良好人数、良好率、优秀人数、优秀率及教师积分进行统计分析。
代码：﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍﹍Sub 统计参数()Application.ScreenUpdating = False '屏蔽刷屏Application.DisplayAlerts = False '禁止弹出提示Dim Arr, brr(), d As Object, i As Long, j As Long, k As Long, m As Long, s As Long, t As Long, Endrow As Long, EndColumn As LongSet d = CreateObject("scripting.dictionary") '用代码创建字典Sheets("成绩分析").DeleteOn Error GoTo 0With Sheets("原始数据")Endrow = .Cells(Rows.Count, 1).End(3).Row - 1 'A列最大单元格减1,即获取行数EndColumn = .Cells(2, Columns.Count).End(1).Column '获取列数Arr = .Cells(2, 1).Resize(Endrow, EndColumn).Value '把"原始数据"表从Cells(2, 1)到最后一个单元格的数值装入arrEnd WithReDim brr(1 To UBound(Arr), 1 To 12) '重新声明brr,行从1到最后1行，列从1到12For j = 5 To UBound(Arr, 2) 'j从第5列到最后一列（从第二行读取列数）For i = 2 To UBound(Arr) 'i从第2行到最后一行If Len(Arr(i, j)) Then '当(Arr(i, j)不为空时s = d(Arr(1, j) & Arr(i, 1) & Arr(i, 3)) 'd() 标题（学科）年级班别If s = Empty Thenm = m + 1d(Arr(1, j) & Arr(i, 1) & Arr(i, 3)) = ms = mbrr(s, 1) = Arr(i, 1) '把各年级装入数组brr(s, 1)brr(s, 2) = Arr(i, 3) '把各班别装入数组brr(s, 1)brr(s, 3) = Arr(1, j) '把各科目装入数组brr(s, 1)End Ifbrr(s, 4) = brr(s, 4) + 1 'brr(s, 4)计数brr(s, 5) = brr(s, 5) + Arr(i, j) 'brr(s, 5)累加成绩brr(s, 6) = Format(brr(s, 5) / brr(s, 4), "0.00") 'brr(s, 5)装入平均成绩'明确各科部分，以便计算出其“三率”If Arr(1, j) = "语文" Or Arr(1, j) = "数学" Or Arr(1, j) = "英语" Then k = 120 '如果所在列为语文Or数学or英语则总分k = 120分.If Arr(1, j) = "物理" Or Arr(1, j) = "化学" Then k = 100'如果所在列为"物理" Or"化学"则' 总分k = 100分.If Arr(1, j) = "政治" Or Arr(1, j) = "历史" Or Arr(1, j) = "生物" Then k = 60 '如果所在列为"政治" Or "历史" Or "生物"则总分k = 60分.If Arr(i, j) >= 0.6 * k Then brr(s, 7) = brr(s, 7) + 1'统计及格人数，存入brr(s, 7)If Arr(i, j) >= 0.8 * k Then brr(s, 9) = brr(s, 9) + 1'统计良好人数，存入brr(s, 9)If Arr(i, j) >= 0.9 * k Then brr(s, 11) = brr(s, 11) + 1'统计优秀人数，存入brr(s, 11)brr(s, 8) = Format(brr(s, 7) / brr(s, 4), "0.00%")' 计算及格率，格式为%，存入brr(s, 8)brr(s, 10) = Format(brr(s, 9) / brr(s, 4), "0.00%")' 计算良好率，格式为%，存入brr(s,10)brr(s, 12) = Format(brr(s, 11) / brr(s, 4), "0.00%")' 计算优秀率，格式为%，存入brr(s, 12)End IfNextNextWith Sheets.Add(After:=Sheets(Sheets.Count)).Name = "成绩分析" '新建工作表，并命名为"成绩分析"End WithWith Sheets("成绩分析").Cells(3, 1).Resize(1000, 14).ClearContents '清除指定区域.Cells(3, 1).Resize(1000, 14).UnMerge '清除合并，即将一个合并区域分成多个单元格.Cells(4, 1).Resize(m, 14).Value = brr '把brr数组填入Cells(4, 1).Resize(m, 14).Cells(3, 1).Resize(1, 14).Value = Array("年级", "班级", "学科", "参考人数", "总分", "平均分", "及格人数", "及格率", "良好人数", "良好率", "优秀人数", "优秀率", "积分", "任课老师") '标题填入Cells(3, 1).Resize(1, 14)With .Cells(3, 1).Resize(m + 1, 14) '在整个数据区域.Sort key1:=.Cells(4, 1), order1:=xlAscending, key2:=.Cells(4, 2), order2:=xlAscending, Header:=xlYes'单元格区域.Sort关键字1:=单元格区域("A4"),.Borders.LineStyle = xlNone '取消边框.Borders.LineStyle = xlContinuous '区域内单元格的边框线为实线End WithWith .Cells(4, 1).Resize(m, 1) '选定操作范围，B4至Bm。
