成绩统计人数错误

lsc900707

lzqlaj 发表于 2016-4-30 17:30
欢迎试用本人多年前做的小程序。

我做过函数版，但最烦容错。我试着去录宏解决，又不知道优化代码和整合，时间长，按钮多，同事反倒不用。我找了好多类似的程序，这款离我的要求最接近。我个人很喜欢它，我觉得很好用。只是少了一个个人的成绩总分和排名。你能再修改一下就更好了。我想让我的同事知道，excel远比他们想象的强大得多！

lzqlaj

Private Sub UserForm_Initialize()
    Application.ScreenUpdating = False
    jgl.Text = 1
    l = [IV2].End(xlToLeft).Column
    p = [a65536].End(xlUp).Row
    For j = 3 To l
        If Cells(2, j) = "总分" Then
            ksl = j
            Exit For
        End If
    Next j
    If ksl <> 0 Then kms.Text = (ksl - 3)
    If ksl = 0 Then kms.Text = (l - 7) / 2
    For i = 1 To l
        If Cells(2, i) = "班级" Then
            k1 = i
            ComboBox1.Value = GetColName(k1)
            Exit For
        Else
            ComboBox1.Value = ""
        End If
    Next i
    bjhs.Text = 2
    ComboBox2.Value = GetColName(3)
    jgl.Text = 0
    On Error Resume Next
    If l > 0 Then
        ComboBox1.Clear
        ComboBox2.Clear
        For i = 1 To l
            ComboBox1.AddItem GetColName(i)
            ComboBox2.AddItem GetColName(i)
        Next i
    End If
    For k = 3 To p
        Cells(k, l - 1) = Application.WorksheetFunction.Sum(Range(Cells(k, 3), Cells(k, l - 2)))
    Next k
    For k = 3 To p
        Cells(k, l) = Application.WorksheetFunction.Rank(Cells(k, l - 1), Range(Cells(3, l - 1), Cells(p, l - 1)))
    Next k
    Application.ScreenUpdating = True
End Sub

lzqlaj

窗体加载时计算总分并排名。

lsc900707

lzqlaj 发表于 2016-4-30 22:50
窗体加载时计算总分并排名。

不好意思，我晚上出去玩了。回来看到你发给我的帖，很感激你的辛勤劳动，更感激你的无私奉献。

lsc900707

lsc900707 发表于 2016-5-1 00:42
不好意思，我晚上出去玩了。回来看到你发给我的帖，很感激你的辛勤劳动，更感激你的无私奉献。

老师，还想麻烦你在“成绩”表里，总分和年级排名中间增加一列“班名”，也就是每个学生的成绩在班内的名次，好吗？

lzqlaj

用数组或 sumproduct函数。

lsc900707

老师，excel工作表会用，但VBA里还不知道用工作表函数来处理。

lsc900707

老师，我把“总分”和“级名”向左平移一列修改好了，可是愚顽的弄了半天也做不了“班名”的排列。

lzqlaj

Sub 宏1()
    Dim ls,  rng, xrows
    ls = Cells(2, 256).End(xlToLeft).Column
    xrows = Range("a65536").End(xlUp).Row
    Set rng = Range(Cells(3, ls), Cells(xrows, ls))
    rng.FormulaR1C1 = "=SUMPRODUCT((R3C1:R" & xrows & "C1=RC1)*(R3C8:R" & xrows & "C8 > RC8))+1"
    rng.Value = rng.Value
    Set rng = Nothing
End Sub

lzqlaj

填充公式。