关键：arr=rst.Getrows
数据表如下：
姓名 成绩 甲 134 乙 84 丙 56 丁 142 戊 94 己 65 庚 79 辛 126 壬 53 癸 87 子 135 丑 85 寅 68 卯 90 辰 119 巳 41 午 118 未 141 申 82 酉 101 戌 107 亥 57
代码如下：
1 '查询第6-15名的学生信息 2 Sub GetRSwithArray() 3 Dim cnn As Object 4 Dim rst As Object 5 Dim strSQL$, strPath$ 6 Dim aData, aResult 7 Dim i&, j& 8 ' 9 strPath = ThisWorkbook.FullName 10 Set cnn = CreateObject("ADODB.Connection") 11 Set rst = CreateObject("ADODB.Recordset") 12 If Application.Version < 12 Then 13 cnn.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & strPath 14 Else 15 cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & strPath 16 End If 17 strSQL = "SELECT top 15 姓名,成绩 FROM [成绩表$] order by 成绩 desc" 18 '前15位 19 rst.Open strSQL, cnn, 1, 3 20 aData = rst.Getrows 21 '记录集转二维数组 22 ReDim aResult(0 To UBound(aData, 2), 0 To UBound(aData, 1) + 1) 23 24 '声明一个新数组，将记录集数组转换过去(转置) 25 For i = 5 To UBound(aData, 2) 26 For j = 0 To UBound(aData, 1) 27 aResult(i - 5, j) = aData(j, i) 28 Next 29 aResult(i - 5, 2) = i + 1 30 '名次 31 Next 32 33 Cells.ClearContents 34 [a1:c1] = Array("姓名", "成绩", "名次") 35 Range("a2").Resize(UBound(aResult), 3) = aResult 36 rst.Close 37 cnn.Close 38 Set rst = Nothing 39 Set cnn = Nothing 40 End Sub