统计每科前十名数据

aman1516

grf1973 发表于 2022-5-24 11:03
给个全新思路，利用数组下标自然有序，用分数作为数组下标。考虑到有小数出现，用分数*10作为数组下标，从 ...

你可以同香川老师争下用数组下标排序的专利了

vivian0526

感谢几位高手！厉害~

cui26896

本不想贴出较慢的方案了，一看讨论很热烈，也贴出自己较慢的方案

1. Sub 简单连接()
   
2. Dim cnn As Object, Rst As Object, SQL$, dtmtms As Date
   
3. Dim i&, j&, x&, ar As Variant, br As Variant, cr As Variant
   
4. Dim lngCT As Long, lngrw&, n&
   
5.   dtmtms = Timer
   
6.   br = Sheet1.[a1:k1 & ""]
   
7.   With Worksheets("结果1")
   
8.     .Activate
   
9.     .Cells.Clear
   
10.     n = 1
    
11.   End With
    
12.   Set cnn = CreateObject("ADODB.Connection")
    
13.   cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes;IMEX=1';Data Source=" & ThisWorkbook.FullName
    
14.   For x = 3 To UBound(br)
    
15.     SQL = "select 班级,姓," & br(x) & " from [成绩$] order by " & br(x) & " desc,班级 "
    
16.     Set Rst = cnn.Execute(SQL)
    
17.     ar = Rst.getrows
    
18.     ReDim cr(1 To UBound(ar, 2) + 1, 1 To UBound(ar) + 2)
    
19.     lngrw = 0
    
20.     For j = 1 To UBound(cr, 2) - 1
    
21.     cr(1, j) = Rst.Fields(j - 1).Name
    
22.     Next
    
23.     cr(1, UBound(cr, 2)) = "名次"
    
24.     lngCT = 1
    
25.     For i = 2 To UBound(cr)
    
26.       If lngCT <= 10 Then
    
27.         cr(i, UBound(cr, 2)) = lngCT
    
28.         For j = 1 To UBound(cr, 2) - 1
    
29.           cr(i, j) = ar(j - 1, i - 2)
    
30.         Next
    
31.           If ar(2, i - 2) <> ar(2, i - 1) Then
    
32.             lngCT = lngCT + 1
    
33.             lngrw = i
    
34.           End If
    
35.       End If
    
36.     Next
    
37.     With Worksheets("结果1")
    
38.       .Activate
    
39.       With .Cells(1, n)
    
40.         .Value = cr(1, 3)
    
41.         .Resize(1, 4).Merge
    
42.       End With
    
43.       .Cells(2, n).Resize(1 + lngrw, UBound(cr, 2)) = cr
    
44.         With .Cells(1, n).Resize(1 + lngrw, UBound(cr, 2))
    
45.           .Borders.LineStyle = xlContinuous
    
46.           With .Font
    
47.             .Name = "微软雅黑"
    
48.             .Size = 11
    
49.           End With
    
50.         End With
    
51.         n = n + 5
    
52.     End With
    
53.   Next
    
54.   cnn.Close
    
55.   Set cnn = Nothing
    
56.   Debug.Print Format(Timer - dtmtms, "0.0000s ")
    
57. End Sub

复制代码