如何计算各科及总分的级部名次和班级名次
问题的提出：可以说学校学生的成绩和名次是最重要，虽然现在要求不能向学生公布成绩，但学校内部评比时还是要看成绩的！！以前计算各科的总分时都是用鼠标直接往下拉，现在已经实现了自动化。就是在循环中调用Sum函数就可以。现在想的是如何确定每位学生学生的①单科的级部名次；②单科的班内名次（此项主要是可以用来计算班内前N名的平均分，也算是比较有用。）③总分的级部名次；④总分的班内名次（此项主要是可以让班主任便于分析本班成绩；同时还可以用来计算班内前N名的平均分。）
问题的分析：①和③可以合并到一块处理；②和④可以合并到一块处理，但①→④都要依赖于总分已经计算完的基础上。
问题的解决过程：
⑴如何计算单科及总分的级部名次
计算前效果截图如下:
Sub 计算单科及总分的级部名次()
'建立验证表,加入名次列,添加标题行.
Worksheets("kh").Activate
ActiveSheet.Copy before:=ActiveSheet
ActiveSheet.Name = "验证"
Application.DisplayAlerts = False
Dim i As Integer
For i = 1 To 10
Range(Cells(1, 12 + (i - 1) * 2), Cells(1, 12 + (i - 1) * 2)).EntireColumn.Insert
Range(Cells(1, 12 + (i - 1) * 2), Cells(1, 12 + (i - 1) * 2)).Value = Range(Cells(1, 11 + (i - 1) * 2), Cells(1, 11 + (i - 1) * 2)).Value + "Jmc"
Next i
Range("A1").CurrentRegion.Columns.AutoFit '必须得加Columns,因为得告诉是对列还是行设置自动适应!!!明白是什么意思了!
Application.DisplayAlerts = True
'ActiveSheet.Delete
'计算单科及总分的级部名次
Dim totalR, j As Integer
Dim mycell, myrange As Range
totalR = Range("A65536").End(xlUp).Row
Debug.Print totalR
'设置两个单元变量,一个mycell存储单元格,一个存储单元格区域.
For i = 1 To 10
For j = 2 To totalR
Set myrange = Range(Cells(2, 11 + (i - 1) * 2), Cells(totalR, 11 + (i - 1) * 2))
Set mycell = Range(Cells(j, 11 + (i - 1) * 2), Cells(j, 11 + (i - 1) * 2))
Range(Cells(j, 12 + (i - 1) * 2), Cells(j, 12 + (i - 1) * 2)).Value = Application.WorksheetFunction.Rank(mycell, myrange, 0)
Next j
Next i
End Sub
计算后效果截图如下:
(2)如何计算单科及总分的班内名次
问题的背景:成绩分析时经常需要计算班内前40名的平均分,而这个前40名是指各科及总分的,以前处理起来都是在VFP中进行,但那样还是需要来回的转换数据格式,所以现在想在Excel中进行解决,如果可以的话,那就更方便了.
首先需要解决如何在原始表中插入单科名次及总分班内名次列.
处理前效果如下图:
源程序如下:
Sub 计算单科及总分的级部和班内名次()
'建立验证表,加入名次列,添加标题行.
Worksheets("kh").Activate
'保证数据的有效性,先把所有空单元格(尤其是假空)填充为0
Cells.Replace what:="", replacement:="0"
ActiveSheet.Copy before:=ActiveSheet
ActiveSheet.Name = "验证"
Application.DisplayAlerts = False
Dim i As Integer
For i = 1 To 10
Range(Cells(1, 12 + (i - 1) * 2), Cells(1, 12 + (i - 1) * 2)).EntireColumn.Insert
Range(Cells(1, 12 + (i - 1) * 2), Cells(1, 12 + (i - 1) * 2)).Value = Range(Cells(1, 11 + (i - 1) * 2), Cells(1, 11 + (i - 1) * 2)).Value + "Jmc"
Next i
Range("A1").CurrentRegion.Columns.AutoFit '必须得加Columns,因为得告诉是对列还是行设置自动适应!!!明白是什么意思了!
Application.DisplayAlerts = True
'ActiveSheet.Delete
'计算单科及总分的级部名次
Dim totalR, j, totalC As Integer
Dim mycell, myrange As Range
totalR = Range("A65536").End(xlUp).Row
'Debug.Print totalR
'设置两个单元变量,一个mycell存储单元格,一个存储单元格区域.
For i = 1 To 10
For j = 2 To totalR
Set myrange = Range(Cells(2, 11 + (i - 1) * 2), Cells(totalR, 11 + (i - 1) * 2))
Set mycell = Range(Cells(j, 11 + (i - 1) * 2), Cells(j, 11 + (i - 1) * 2))
Range(Cells(j, 12 + (i - 1) * 2), Cells(j, 12 + (i - 1) * 2)).Value = Application.WorksheetFunction.Rank(mycell, myrange, 0)
Next j
Next i
'计算各科及总分的班内名次,解决的思路就是在按班级排序的基础上,统计出各班人数,然后再按先班级后单科及总分的顺序进行排序,排序后填入名次即可.
Dim rs(25) As Integer
For j = 1 To 25
rs(j) = Application.WorksheetFunction.CountIf(Range(Cells(2, 1), Cells(totalR, 1)), Format(Str(j)))
'Debug.Print Str(j) & "班人数为:" & rs(j)
Next j
'按先教学班后总分名次排序
totalC = Range("A1").CurrentRegion.Columns.Count '统计当前区域内非空数据的列数
Range(Cells(1, 1), Cells(totalR, totalC)).Sort key1:=Range("A2"), order1:=xlAscending, _
header:=xlYes, key2:=Range("AD2"), order2:=xlAscending
'插入各科及总分的班内名次列
For i = 1 To 10
Range(Cells(1, 13 + (i - 1) * 3), Cells(1, 13 + (i - 1) * 3)).EntireColumn.Insert
Range(Cells(1, 13 + (i - 1) * 3), Cells(1, 13 + (i - 1) * 3)).Value = Range(Cells(1, 11 + (i - 1) * 3), Cells(1, 11 + (i - 1) * 3)).Value + "Bmc"
Next i
Dim k As Integer
k = 0
For i = 1 To 10
'按先教学班后单科及总分级名次排序
Range(Cells(2, 1), Cells(totalR, totalC)).Sort key1:=Range("A2"), order1:=xlAscending, _
header:=xlYes, key2:=Range(Cells(2, 12 + (i - 1) * 3), Cells(2, 12 + (i - 1) * 3)), order2:=xlAscending
'按先班级后科目填充班内名次
For j = 1 To 25
k = k + rs(j)
For m = 1 To rs(j)
Cells(k - rs(j) + m + 1, 13 + (i - 1) * 3) = Str(m)
Next m
Next j
k = 0
Next i
End Sub
完成后效果截图如下:
反思:上面的源程序实际上已经把两步名次的填充已合并为一体了.
今天你菊子曰了么？