|
今天有个叫“猫哥”的群友私信给我,提及如何转置保存数据。当时的反应是,Recordset里好像是没有这个的。所以推荐他使用Excel里的Transpose内置函数来处理,大体思路是用GetRows来讲记录集转为数组,然后再Transpose,再赋值给单元格区域。 后来回头去看看以前写的帖子,发现使用GetRows时,——实话说,我很少用这个方法{:soso_e110:}——已经把行列置换了。换句话说,根本不必再用Transpose了,只需要将单元格重置成符合维度的区域即可。
- '函数说明:
- '作用:..........................................导出数据,或转置导出数据
- '引用库:........................................Excel库、ADO库。
- '附件:..........................................根目录下需包含文件ExportData空白工作表,用于存储数据
- '参数:
- ' strSQL....................................必选,SQL查询语句
- ' isTranspose...............................可选,是否转置,默认为不转置。
- '调用方法:
- 'Call ExportData("第三季度套餐",True)............转置导出表“第三季度套餐”的数据。
- '其它:
- '由于使用了Excel组件,因此导出数据时比普通的DoCmd.TransferSpreadsheet运行要慢,建议需要转置时再使用本函数。
- Function ExportData(ByVal strSQL As String, Optional ByVal isTranspose As Boolean = False)
-
- Dim rst As New ADODB.Recordset
-
- Dim exl As New Excel.Application
- Dim wb As Workbook
- Dim wsh As Worksheet
- '定以数组,arrFields用于存放表头,arrData用于转置数据
- Dim arrFields, arrData
-
- Dim i As Long
-
- rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
- '打开工作簿
- Set wb = exl.Workbooks.Open(CurrentProject.Path & "\ExportData.xls")
- Set wsh = wb.ActiveSheet
- '清除旧数据
- wsh.Cells.ClearContents
- '重定以数组维度,以便存放表头独居
- ReDim arrFields(rst.Fields.Count - 1)
-
- For i = 0 To rst.Fields.Count - 1
- arrFields(i) = rst.Fields(i).Name
- Next
-
- If isTranspose Then
- arrData = rst.GetRows()
- '处理表头:
- 'Resize用于扩展区域。需要注意的是,单元格作为数组来存储数据,是从1开始的,因此后面所有的单元格都要resize到Ubound+1
- wsh.Range("A1").Resize(UBound(arrFields) + 1) = exl.WorksheetFunction.Transpose(arrFields)
- wsh.Range("B1").Resize(UBound(arrData, 1) + 1, UBound(arrData, 2) + 1) = arrData
- Else
- wsh.Range("A1").Resize(, UBound(arrFields) + 1) = arrFields
- wsh.Range("A2").CopyFromRecordset rst
- End If
- '保存并退出Excel
- wb.Save
- wb.Close
- exl.Quit
- '关闭记录集
- rst.Close
- End Function
复制代码
这里涉及到Excel单元格的CopyFromRecordset方法以及Resize重置单元格区域范围【其实这时候的单元格相当于一个可扩展的1×1数组】,数组的一些基本属性使用(例如Ubound判断某个维度的上限,Transpose用于转置数组)
此贴就当做Recordset的番外篇吧。有兴趣的版友可以结合以下帖子来看:
http://www.office-cn.net/thread-119067-1-1.html
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
评分
-
查看全部评分
|