如何根据原始表关键列班级和总分给每班总分成绩后5名学生标记

yzyyyyyyy

原始表：关键列，班级，姓名，总分。其中的班排，级排列为测试用，原表中无。

根据关键列，提取总分班级名次后5名（若并列多人，只取5人）到提取记录工作表中。并在原始表中标记列，加上记号两字。 如何根据原始表关键列班级和总分给每班总分成绩后5名学生标记.rar (6.06 KB, 下载次数: 12)

2024-9-28 20:08 上传

点击文件名下载附件

飞天篮球猪

供参考...可以使用集算器在生成结果同时修改原文件。

lcluck2002

作业做完就交一下。。。。。

A刘志勇

公式给弄出来 了

A刘志勇

公式做出来 了，你看看

3190496160

Sub 筛选标记()
Dim ar As Variant, cr As Variant
Dim i As Long, r As Long, rs As Long
Dim br(), brr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("原始表")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "原始表为空，请先导入数据！": End
    .Range("h2:h" & r) = Empty
    ar = .Range("a1:h" & r)
    For i = 2 To UBound(ar)
        If ar(i, 1) <> "" Then
            w = ar(i, 1)
            If Not d.exists(w) Then Set d(w) = CreateObject("scripting.dictionary")
            d(w)(i) = ""
        End If
    Next i
    ReDim brr(1 To d.Count * 2, 1 To 6)
    For Each k In d.keys
        n = 0
        ReDim br(1 To UBound(ar), 1 To UBound(ar, 2) + 1)
        m = m + 1
        brr(m, 1) = k & "班"
        For Each kk In d(k).keys
            If ar(kk, 1) <> "" Then
                n = n + 1
                For j = 1 To UBound(ar, 2)
                    br(n, j) = ar(kk, j)
                Next j
                br(n, UBound(br, 2)) = kk
            End If
        Next kk
        For i = 1 To n
            For s = i + 1 To n
                If br(i, 4) > br(s, 4) Then
                    For j = 1 To UBound(br, 2)
                        mk = br(i, j)
                        br(i, j) = br(s, j)
                        br(s, j) = mk
                    Next j
                End If
            Next s
        Next i
        m = m + 1: y = 1
        For s = 1 To 5
            y = y + 1
            brr(m, y) = br(s, 3)
            ar(br(s, 9), 8) = "记号"
        Next s
        brr(m - 1, 2) = y - 1 & "人"
    Next k
    .Range("h1").Resize(UBound(ar), 1) = Application.Index(ar, 0, 8)
End With
With Sheets("标记名单下发")
    .UsedRange = Empty
    .[a1].Resize(m, UBound(brr, 2)) = brr
End With
MsgBox "ok!"
End Sub

3190496160

如何根据原始表关键列班级和总分给每班总分成绩后5名学生标记.rar (17.93 KB, 下载次数: 1)

2024-9-29 09:42 上传

点击文件名下载附件

3190496160

相同分数的究竟是算一个还是算多个，不明确，代码仅供参考

一招秒杀

3190496160 发表于 2024-9-29 09:43
相同分数的究竟是算一个还是算多个，不明确，代码仅供参考

各种数据库中27年前就陆续 提供各种排名函数，已经成炒了一种标准。
VBA t自1993年推出后，几乎再也没有更新过，什么东西都要自己动手，
例如 各种（分区）排名, 就好像 造车，哪怕一个螺丝、轮子都要自己造。
自己制造螺丝，重复发明轮子，都是极低效率的。