在年级成绩单中提取每班的后十名

雄飞的小鸡

我提供来年级成绩单，怎么提取每班的后十名的学生名单

雄飞的小鸡

大神帮帮我

一把小刀闯天下

'每班至少有10名学生。每班按总分进行排名，仅取10名，不考虑并列，，，

Option Explicit

Sub test()
  Dim arr, i, j, k, kk, m
  arr = Range("a1:l" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
  Call bsort(arr, 2, UBound(arr, 1) - 1, 1, UBound(arr, 2), 2) '班级升序
  m = 1
  For i = 2 To UBound(arr, 1) - 1
    For j = i To UBound(arr, 1) - 1
      If arr(j, 2) <> arr(j + 1, 2) Then
        Call bsort(arr, i, j, 1, UBound(arr, 2), 3) '总分升序
        For k = i To i + 9
          m = m + 1
          For kk = 1 To UBound(arr, 2)
            arr(m, kk) = arr(k, kk)
        Next kk, k
        i = j: Exit For
      End If
  Next j, i
  With [o2]
    .Resize(Rows.Count - 1, UBound(arr, 2)).ClearContents
    .Resize(m, UBound(arr, 2)) = arr
  End With
End Sub

Function bsort(arr, first, last, left, right, key)
  Dim i, j, k, t
  For i = first To last - 1
    For j = first To last + first - 1 - i
      If arr(j, key) > arr(j + 1, key) Then
        For k = left To right
          t = arr(j, k): arr(j, k) = arr(j + 1, k): arr(j + 1, k) = t
        Next
      End If
  Next j, i
End Function

雄飞的小鸡

一把小刀闯天下 发表于 2019-6-12 11:56
'每班至少有10名学生。每班按总分进行排名，仅取10名，不考虑并列，，，

Option Explicit

考虑并列，如果都是倒数第三，都提取，谢谢

一把小刀闯天下

雄飞的小鸡 发表于 2019-6-12 12:13
考虑并列，如果都是倒数第三，都提取，谢谢

美式排名没有倒数第10你怎么处理？比如9，9，9，12你怎么取最后10名？

一把小刀闯天下

'只要>倒10名就结束，这样倒10名就可以不存在

'支持并列排名，看AA列倒排名情况，，，

Option Explicit

Sub test()
  Dim arr, i, j, k, kk, m
  arr = Range("a1:m" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
  Call bsort(arr, 2, UBound(arr, 1) - 1, 1, UBound(arr, 2), 2) '班级升序
  m = 1
  For i = 2 To UBound(arr, 1) - 1
    For j = i To UBound(arr, 1) - 1
      If arr(j, 2) <> arr(j + 1, 2) Then
        Call bsort(arr, i, j, 1, UBound(arr, 2), 3) '总分升序
        Call rank(arr, i, j, 3, 13, True) '倒数排名
        For k = i To UBound(arr, 1) - 1
          If arr(k, 13) > 10 Then Exit For
          m = m + 1
          For kk = 1 To UBound(arr, 2)
            arr(m, kk) = arr(k, kk)
        Next kk, k
        i = j: Exit For
      End If
  Next j, i
  With [o2]
    .Resize(Rows.Count - 1, UBound(arr, 2)).ClearContents
    .Resize(m, UBound(arr, 2)) = arr
  End With
End Sub

Function rank(arr, first, last, key, col, order)
  Dim i, j, m
  m = 1: arr(first, col) = 1
  For i = first + 1 To last
    If order Then
      m = m + 1
    Else
      If arr(i, key) <> arr(i - 1, key) Then m = m + 1
    End If
    arr(i, col) = IIf(arr(i, key) = arr(i - 1, key), arr(i - 1, col), m)
  Next
End Function

Function bsort(arr, first, last, left, right, key)
  Dim i, j, k, t
  For i = first To last - 1
    For j = first To last + first - 1 - i
      If arr(j, key) > arr(j + 1, key) Then
        For k = left To right
          t = arr(j, k): arr(j, k) = arr(j + 1, k): arr(j + 1, k) = t
        Next
      End If
  Next j, i
End Function

xiangbaoan

Option Explicit
Sub daoshu10() '倒1，倒2，倒3……其中含并列，倒数学生>=10人
Dim cnn As Object, sql$, c%
Range("o2:p" & Rows.Count).ClearContents
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
For c = 1 To 7
    sql = "select top 10 姓名,班级 from [Sheet1$a1:l] where 班级=" & c & " order by 年级排名 desc"
    Cells(Rows.Count, "o").End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(sql)
Next
cnn.Close
Set cnn = Nothing
End Sub

740688321

xiangbaoan 发表于 2019-6-12 13:23
Option Explicit
Sub daoshu10() '倒1，倒2，倒3……其中含并列，倒数学生>=10人
Dim cnn As Object, sql ...

sql = "select top 10 姓名,班级 from [Sheet1$a1:l] where 班级=" & c & " order by 年级排名 desc"
你这个是从哪儿看来的，给点资料让大家学习一下。

xiangbaoan

740688321 发表于 2019-6-12 13:35
sql = "select top 10 姓名,班级 from [Sheet1$a1:l] where 班级=" & c & " order by 年级排名 desc"
...

百度Excel VBA ADO SQL入门教程，目前有25讲，看见星光大师作品，另外本论坛可学的也太多了……

雄飞的小鸡

一把小刀闯天下 发表于 2019-6-12 12:34
'只要>倒10名就结束，这样倒10名就可以不存在

'支持并列排名，看AA列倒排名情况，，，

多谢大神，多问一个，成绩单在sheet1里，我想把结果显示在sheet2里该怎么办