转置小技巧——浅谈GetRows的使用

roych

        今天有个叫“猫哥”的群友私信给我，提及如何转置保存数据。当时的反应是，Recordset里好像是没有这个的。所以推荐他使用Excel里的Transpose内置函数来处理，大体思路是用GetRows来讲记录集转为数组，然后再Transpose，再赋值给单元格区域。       后来回头去看看以前写的帖子，发现使用GetRows时，——实话说，我很少用这个方法{:soso_e110:}——已经把行列置换了。换句话说，根本不必再用Transpose了，只需要将单元格重置成符合维度的区域即可。

1. '函数说明：
   
2. '作用：..........................................导出数据，或转置导出数据
   
3. '引用库：........................................Excel库、ADO库。
   
4. '附件：..........................................根目录下需包含文件ExportData空白工作表，用于存储数据
   
5. '参数：
   
6. '      strSQL....................................必选，SQL查询语句
   
7. '      isTranspose...............................可选，是否转置，默认为不转置。
   
8. '调用方法：
   
9. 'Call ExportData("第三季度套餐",True)............转置导出表“第三季度套餐”的数据。
   
10. '其它：
    
11. '由于使用了Excel组件，因此导出数据时比普通的DoCmd.TransferSpreadsheet运行要慢，建议需要转置时再使用本函数。
    
12. 
    
13. 
    
14. Function ExportData(ByVal strSQL As String, Optional ByVal isTranspose As Boolean = False)
    
15.    
    
16.     Dim rst As New ADODB.Recordset
    
17.    
    
18.     Dim exl As New Excel.Application
    
19.     Dim wb As Workbook
    
20.     Dim wsh As Worksheet
    
21.     '定以数组，arrFields用于存放表头，arrData用于转置数据
    
22.     Dim arrFields, arrData
    
23.    
    
24.     Dim i As Long
    
25.    
    
26.     rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    
27.     '打开工作簿
    
28.     Set wb = exl.Workbooks.Open(CurrentProject.Path & "\ExportData.xls")
    
29.     Set wsh = wb.ActiveSheet
    
30.     '清除旧数据
    
31.     wsh.Cells.ClearContents
    
32.     '重定以数组维度，以便存放表头独居
    
33.     ReDim arrFields(rst.Fields.Count - 1)
    
34.    
    
35.     For i = 0 To rst.Fields.Count - 1
    
36.         arrFields(i) = rst.Fields(i).Name
    
37.     Next
    
38.    
    
39.     If isTranspose Then
    
40.         arrData = rst.GetRows()
    
41.         '处理表头：
    
42.         'Resize用于扩展区域。需要注意的是，单元格作为数组来存储数据，是从1开始的，因此后面所有的单元格都要resize到Ubound+1
    
43.          wsh.Range("A1").Resize(UBound(arrFields) + 1) = exl.WorksheetFunction.Transpose(arrFields)
    
44.          wsh.Range("B1").Resize(UBound(arrData, 1) + 1, UBound(arrData, 2) + 1) = arrData
    
45.     Else
    
46.         wsh.Range("A1").Resize(, UBound(arrFields) + 1) = arrFields
    
47.         wsh.Range("A2").CopyFromRecordset rst
    
48.     End If
    
49.     '保存并退出Excel
    
50.     wb.Save
    
51.     wb.Close
    
52.     exl.Quit
    
53.     '关闭记录集
    
54.     rst.Close
    
55. End Function

复制代码

       这里涉及到Excel单元格的CopyFromRecordset方法以及Resize重置单元格区域范围【其实这时候的单元格相当于一个可扩展的1×1数组】，数组的一些基本属性使用（例如Ubound判断某个维度的上限，Transpose用于转置数组）
       此贴就当做Recordset的番外篇吧。有兴趣的版友可以结合以下帖子来看：
      http://www.office-cn.net/thread-119067-1-1.html

tmtony

Access Excel 跨界 更强大!

zhuyiwen

真不错！{:soso_e179:}

522650696

很厉害的样子

李力军2

这个有用,收藏了

yanwei82123300

好例子,acces+excel 太强大了