Recordset Rst 直接写入Worksheet

如下这段代码来自网页。
其中的copy ado查询后的数据这块儿比较简介，可参考之。

SQL代码：

Sub Test()

Dim WbNamePath As String, Sht As Worksheet, SQL As String

Set Sht = Sheet4

'存放结果的工作表

WbNamePath =ThisWorkbook.FullName  '设置工作簿的完整路径和名称

'SQL语句

SQL = "select * from (select
	省份,项目设计,数量,金额 from [项目表$] union all select [省份]&' 汇总',
	count(项目设计) as 项目设计 ,sum(数量) as 数量, sum(金额) as 金额 from [项目表$] group
	by 省份) order by 省份"

Call SQL执行(WbNamePath, Sht,SQL)

End Sub

​

'以下程序是公共程序，直接使用，不用修改

Sub SQL执行(WbNamePath As String, Sht, SQLstr As String)

Dim Conn As Object, Rst As Object

Dim strConn As String, strSQL As String

Dim i As Integer, PathStr As String

Set Conn = CreateObject("ADODB.Connection")
Set Rst = CreateObject("ADODB.Recordset")

On Error GoTo 出错提示

PathStr = WbNamePath

'设置工作簿的完整路径和名称

Select Case
Application.Version * 1  
'设置连接字符串,根据版本创建连接
	Case Is <= 11
'03以下版本包含03    
strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
	Case Is >= 12
'07以上版本包含07
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
End Select

Conn.Open strConn

'打开数据库链接
strSQL = SQLstr
'设置SQL查询语句
Set Rst = Conn.Execute(strSQL)
'执行查询，并将结果输出到记录集对象
With Sht
.Cells.Clear
For i = 0 To Rst.Fields.Count - 1
'填写标题
.Cells(1,i + 1) = Rst.Fields(i).Name
Next i
Range(“A2”).CopyFromRecordset Rst
.Cells.EntireColumn.AutoFit
'自动调整列宽
End With
Rst.Close: Conn.Close
'关闭数据库连接
Set Conn = Nothing: Set Rst = Nothing '释放对象变量
Exit Sub

出错提示:

MsgBox Err.Description, ,

“ADO 程序有错，请检查”

End Sub

解题思路分享：

提出的要求是要保留原来的数据并分类汇总

1.保留原来数据的SQL语句

select 省份,项目设计,数量,金额 from [项目表$]

2.分类汇总(省份字段为划分)的SQL语句：

select [省份]&’ 汇总’, count(项目设计) as 项目设计,sum(数量) as 数量, sum(金额) as 金额 from [项目表$] group by 省份

3.把上面二个数据放在一起，在SQL中称为连接

4.把放在一起的表按省份进行排序，这样汇总的最省份的最一行，实现最终分类汇总的效果