请教，如何一键提取各班成绩（不在同一列）至一个表，然后进行排名汇总？

gery_1

请教论坛老师，如何一键提取各班成绩（不在同一列）至一个表，然后进行排名汇总？我复制了论坛里一位老师的VBA代码，但是总是出错。谢谢各位老师不吝赐教！（我不会vba，只会一些简单的公式，请老师帮忙改正一下，谢谢！）


补充内容 (2019-6-5 13:33):
部分最新修改后的见14楼附件

补充内容 (2019-6-11 16:44):
最终修改完善附件见15楼。

zpy2

这样子的格式后期汇总需要代码，不如都登记在一张数据表里
rowid        年级        学校        组别        学号        姓名        语文        数学        新增
1        1年级        学校1        组1        1        郭奕涵        100        100        复制
2        1年级        学校1        组1        2        郭雨航        100        100        复制
3        1年级        学校1        组1        3        郭柳媛        100        100        复制
4        1年级        学校1        组1        4        韩宇昕        100        100        复制
5        1年级        学校1        组1        5        韩佳洺        100        10
排名可以看看
http://club.excelhome.net/forum.php?mod=viewthread&tid=1477182&mobile=2

蓝桥玄霜

请见代码。

gery_1

蓝桥玄霜 发表于 2019-5-20 13:52
请见代码。

老师您好，为什么vba代码是图片格式的？不能复制呀？

gery_1

zpy2 发表于 2019-5-20 13:51
这样子的格式后期汇总需要代码，不如都登记在一张数据表里
rowid        年级        学校        组别        学号        姓名        语文        数学        新 ...

谢谢您的帮助，但是我不懂vba，不会改vba。

zpy2

gery_1 发表于 2019-5-22 18:13
谢谢您的帮助，但是我不懂vba，不会改vba。

哦，我这个不是vba的，是在线php和数据库的，我意思是各班成绩整理到一张表，就可以用一条sql语句进行排名了。
你如果需要的话，可以连到我的主机

zpy2

zpy2 发表于 2019-5-22 19:51
哦，我这个不是vba的，是在线php和数据库的，我意思是各班成绩整理到一张表，就可以用一条sql语句进行排 ...

另外，如果想学vba的话，研究一下兰版的代码绝对大有裨益。

zpy2

手动挡排了一下。。。

gery_1

Sub 年级总排名()
Dim Sht As Worksheet, Arr, i&, Brr(1 To 500, 1 To 10), n&
Dim bj$, ks, js, j&, r%, Arr1(), Crr
Application.ScreenUpdating = False
Sheet7.Activate
[a2:k5000].ClearContents
For Each Sht In Sheets
   If Len(Sht.Name) < 5 Then
        Arr = Sht.[a1:j41]
        bj = Sht.Name
        For j = 1 To UBound(Arr, 2) Step 5
            For i = 2 To UBound(Arr) - 1
                If Arr(i, j + 1) = "" Then Exit For
                n = n + 1
                Brr(n, 1) = bj
                Brr(n, 2) = Arr(i, j): Brr(n, 3) = Arr(i, j + 1): Brr(n, 4) = Arr(i, j + 2): Brr(n, 5) = Arr(i, j + 3): Brr(n, 6) = Arr(i, j + 4)
            Next
        Next
    End If
Next
[a2].Resize(n, 10) = Brr
[h2].Formula = "=sum(rc4:rc[-1])"
[h2].AutoFill [h2].Resize(n, 1)
[i2].Formula = "=rank(h2,$H$2:$H$" & n + 1 & ")"
[i2].AutoFill [i2].Resize(n, 1)
Crr = [a1].Resize(n + 1, 10)
For i = 2 To n + 1
    If Crr(i - 1, 1) <> Crr(i, 1) Then
        r = r + 1
        ReDim Preserve Arr1(1 To r)
        Arr1(r) = i
    End If
Next
For i = 1 To r
    If i <> r Then
        js = Arr1(i + 1) - 1
    Else
        js = UBound(Crr)
    End If
    ks = Arr1(i)
    ad = Cells(ks, 8).Resize(js - ks + 1, 1).Address
    For j = ks To js
        Cells(j, 10).Formula = "=rank(h" & j & "," & ad & ")"
    Next
Next
Application.ScreenUpdating = True
End Sub

gery_1

感谢zpy2老师，各位老师讲的都很好，可是我还是听不懂，php和数据库我只会点皮毛，是成绩分析网站吗？能否发来源代码的话我可以放到学校服务器上运行一下测试一下。
另外，我将“蓝桥玄霜”老师图片上的代码改写成文本的形式，请大家看看，能否帮我插入到我的excel电子表格中，谢谢。