如何计算各班各班平均分（指定任意名次）

成绩分析还有一个问题就是计算平均分。考虑到各班均有不参加考试的学生，为了公平起见，往往是取前多少名（比如一个班有50名学生，往往都是取前40名或前45名的学生计算平均分）进行计算。现在就来实现这个问题。

源程序如下:

Sub 计算各班各科及总分的平均分()
    Dim rs(25), i, j, k As Integer
    Dim totalR As Integer
    Dim pj(25) As Double
    Dim km(9) As String
    km(1) = "语文"
    km(2) = "数学"
    km(3) = "外语"
    km(4) = "物理"
    km(5) = "化学"
    km(6) = "生物"
    km(7) = "理综"
    km(8) = "能力"
    km(9) = "总分"
    Worksheets("sheet1").Activate
    totalR = Range("A65536").End(xlUp).Row
    k = 0
    For i = 1 To 9
        For j = 1 To 25
            Worksheets("sheet1").Activate
            rs(j) = Application.WorksheetFunction.CountIf(Range(Cells(2, 1), Cells(totalR, 1)), Trim(Str(j)))
            k = k + rs(j)
            If rs(j) <> 0 Then
                pj(j) = Application.WorksheetFunction.Average(Range(Cells(k - rs(j) + 2, i + 3), Cells(k + 1 - 5, i + 3)))
            Else
                pj(j) = 0
            End If
            Debug.Print Trim(Str(j)) & "班" & km(i) & "前" & Trim(Str(rs(j) - 5)) & "平均分为:" & pj(j)
            Worksheets("sheet3").Activate
            Range(Cells(j + 1, i + 1), Cells(j + 1, i + 1)).Value = pj(j)
        Next j
        k = 0
    Next i
    Worksheets("sheet3").Activate '删除文科班,利用文科班所在行的各段人数均为0,那么可以按行统计单元格为0的个数,若等于9(科目数),则必为文科班,即可以把该行删掉.
    totalR = Range("A65536").End(xlUp).Row
    totalC = Range("IV1").End(xlToLeft).Column
    Debug.Print totalC
    For i = totalR To 1 Step -1 '若从第一行开始,一旦出现了删除结果,会导致行数不对.易出现漏删现象.
        If Application.WorksheetFunction.CountIf(Range(Cells(i, 1), Cells(i, totalC)), "0") = 9 Then
            Range(Cells(i, 1), Cells(i, totalC)).EntireRow.Delete
        End If
    Next i
End Sub

最终效果如下图所示:

最头疼的问题基本上已经解决了．下次考试是不是就要试试了？希望会成功！！！

 今天你菊子曰了么？