关于在年级成绩表中提取各班前3名的姓名和成绩

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$, i%
    Set Cn = CreateObject("Adodb.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    For i = 1 To 9
        StrSQL = StrSQL & " union all Select  Top 3 *  From [Sheet1$A:C] Where 班级=" & i
    Next i
    Range("E2").CopyFromRecordset Cn.Execute(Mid(StrSQL, 12))
End Sub

joy.008@163.com

弱弱的问一句 是不是在VBA中使用large函数会更快捷?为啥还要大段的冒泡排序呢?

limonet

wengjl 发表于 2024-4-11 09:01
第三名并列分如何处理？

此帖没有并列分的。

LIUZHU

这个效果，考虑了考分相同的影响

LIUZHU

JSA代码，请参考

1. function 数据提取(){
   
2.         let arr=Sheets.Item("Sheet1").Range("a1").CurrentRegion.Value2.slice(1);
   
3.         arr.sort((a,b)=>b[2]-a[2]);                //成绩按年级排序
   
4.         let obj=arr.reduce((dic,x)=>{
   
5.                 let temp=dic[x[1]]=dic[x[1]] || [];
   
6.                 if (temp.length<3){
   
7.                         temp.push(x);
   
8.                 }else{
   
9.                         let tp=temp[temp.length-1];
   
10.                         if (x[2]==tp[2]) temp.push(x);                //相同分数
    
11.                 }
    
12.                 return dic;
    
13.         },{});
    
14.         let res=[["姓名","班级","总分"]].concat(Object.values(obj).flat());
    
15.         Range("j1").Resize(res.length,res[0].length).Value2=res;
    
16. }

复制代码

LIUZHU

附件请审核，WPS有效

cai2532

不错，学习收藏了。

77831521

LIUZHU 发表于 2024-4-11 11:59
附件请审核，WPS有效

我这边运行出错是什么原因

77831521

已达到所要的效果，感谢各位的倾心帮助

yanglinzi

3190496160 发表于 2024-4-11 09:34
Sub 提取前n名()
Dim ar As Variant
Dim br()

,large和index函数用的好，又学一招。