|
- sql解法
- Sub test()
- Dim sql$, arr
- sql = "select top 4 名字 from (select 名字,count(*) as cnt from [Sheet1$] group by 名字) order by cnt desc"
- arr = GET_SQL(sql, False)
- [b2:e2] = WorksheetFunction.Transpose(arr)
- End Sub
- Public Function GET_SQL(strSQL As String, Optional HasHeader As Boolean = True) As Variant()
- Dim Cn, Rs, arr(), i%, j%
- Set Cn = CreateObject("ADODB.Connection")
- Set Rs = CreateObject("ADODB.Recordset")
- If Application.Version < 12 Then
- Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
- Else
- Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
- End If
- Rs.Open strSQL, Cn, 1, 3
- If HasHeader = True Then
- ReDim arr(0 To Rs.RecordCount, 0 To Rs.Fields.Count - 1)
- For i = 0 To Rs.Fields.Count - 1
- arr(0, i) = Rs.Fields(i).Name
- Next
- For i = 0 To Rs.RecordCount - 1
- For j = 0 To Rs.Fields.Count - 1
- arr(i + 1, j) = Rs.Fields(j).Value
- Next
- Rs.MoveNext
- Next
- Else
- ReDim arr(0 To Rs.RecordCount - 1, 0 To Rs.Fields.Count - 1)
- For i = 0 To Rs.RecordCount - 1
- For j = 0 To Rs.Fields.Count - 1
- arr(i, j) = Rs.Fields(j).Value
- Next
- Rs.MoveNext
- Next
- '注意用GetRows方法转置会遇到NULL转置报错的情况
- End If
- GET_SQL = arr
- Cn.Close
- Set Rs = Nothing
- Set Cn = Nothing
- End Function
复制代码 |
评分
-
1
查看全部评分
-
|