用vba统计分析学生成绩(三率)

1、精品用 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 A

2、s Long, EndColumn As Long感谢下载载精品Set 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'获取

3、列数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,

4、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

5、, 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) = " 英语 "

6、; 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 =

7、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

8、) + 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%")' 计算优秀率，格式为 %

9、 ，存入 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).

10、Resize(m, 14).Value = brr'把 brr 数组填入 Cells(4, 1).Resize(m,14).Cells(3, 1).Resize(1, 14).Value = Array("年级 ", " 班级 ", " 学科 ", " 参考人数 ", " 总分 ", " 平均分 ", " 及格人数 ", " 及格率 ", " 良好人数 ", " 良好率 ", "

11、 优秀人数 ", " 优秀率 ", " 积分 ", " 任课老师 ")'标题填入 Cells(3, 1).Resize(1, 14)With .Cells(3, 1).Resize(m + 1, 14)'在整个数据区域.Sortkey1:=.Cells(4,1),order1:=xlAscending,key2:=.Cells(4,2),order2:=xlAscending, Header:=xlYes' 单元格区域 .Sort 关键字 1:= 单元格区域 ("A4"),.Bor

12、ders.LineStyle = xlNone'取消边框.Borders.LineStyle = xlContinuous' 区域内单元格的边框线为实线End WithWith .Cells(4, 1).Resize(m, 1)'选定操作范围，B4 至 Bm 。.Offset(0, 1).EntireColumn.Insert' 在当前单元格Cells(4, 1) （下同）右侧处插入一列For i = 1 To .Count - 1If.Cells(i).Value=.Cells(i+1).ValueThen.Cells(i).Offset(0,1).Resiz

13、e(2, 1).Merge' 上下单元格相等，右侧相应的合并。Next.Offset(0, 1).Copy'复制当前单元格右列第4 至第 m 个单感谢下载载精品元格.PasteSpecial xlPasteFormats' 粘贴复制的源格式.Offset(0, 1).EntireColumn.Delete'删除右边第1 列End WithWith .Cells(4, 2).Resize(m, 1)' 当前单元格为Cells(4, 2).Offset(0, 1).EntireColumn.InsertFor i = 1 To .Count - 1If.Ce

14、lls(i).Value=.Cells(i+1).ValueThen.Cells(i).Offset(0,1).Resize(2, 1).Merge'上下单元格相等，右侧相应的合并Next.Offset(0, 1).Copy' 复制当前单元格右列第4 至第 m 个单元格.PasteSpecial xlPasteFormats' 粘贴复制的源格式.Offset(0, 1).EntireColumn.Delete' 删除右边第1 列End With.Cells(1, 1).SelectEnd WithWith Sheets("成绩分析 ")t = Range("b65536").End(xlUp).Row' 所要计算的行数For i = 4 To t.Cells(i,13) =