本文将讲解vba连接数据库读取数据,更新数据, vba创建透视图.

vba连接数据库读取数据,更新数据

使用adodb通过windows系统提供的datasource, 即可连接各类数据库并进行crud操作.通过控制面板->Administrative Tools ->DataSource (ODBC) 即可查看和添加/修改datasource. 下面演示如何为oracle添加一个dataSource, 前提是本地要安装oracle客户端.



需要注意的是: TNS Service Name必须是%ORACLE_CLIENT_HOME%/Network/Admin/TNSNAMES.ora中所定义的某个连接的名字.

当然也可以为一个access数据库文件添加dataSource.比如我们有一个叫做1.mdb的access数据库文件, 它有这么几张很经典的表:学生表student(id,name,gender), 老师表teacher(id ,name), 课程表course(id, name, t_id), 学生课程成绩表sc(s_id, c_id, score). 它位于c:/1/1.mdb.则如下图所示为它添加数据源:



因为有人未必安装了oracle或sqlserver数据库, 所以后面的例子将以数据源school为例.因为使用了adodb等,所以要先引入依赖的库,Tools->References,如图所示勾选依赖的library:


下面程序演示怎么连接数据库获取数据,更新数据:


[vb]  view plain copy



1. Sub getStudentInfo()  
2. Dim rs       As ADODB.Recordset  
3. Dim conn     As ADODB.Connection  
4. Dim i As Integer  
5. Dim connectionString As Variant  
6. Dim maxrow&  
7. Set conn = New ADODB.Connection  
8. Set rs = New ADODB.Recordset  
9. Set xlWS = ActiveWorkbook.Worksheets("Sheet1")  
10. Select  
11. End(xlUp).Row  
12. 'DNS指定数据源的名称  
13. "DSN=SCHOOL;UID=;PWD="  
14.     conn.Open connectionString  
15. '先清空sheet  
16. "A1:F" & maxrow + 1).ClearContents  
17. "select a.name,a.gender, b.name,c.name, d.score from student a, course b, teacher c,sc d where b.t_id=c.id and a.id=d.s_id and b.id = d.c_id", conn, adOpenStatic, adLockReadOnly  
18. 'copy 结果集到sheet,从指定的range开始  
19. "A1").CopyFromRecordset rs  
20.     rs.Close  
21. Set rs = Nothing  
22.     conn.Close  
23. Set conn = Nothing  
24. Exit Sub  
25. errhandler:  
26. ' Just exit  
27. Set connn = Nothing  
28. "Problems with database connection", vbOKOnly  
29. End Sub  
30.   
31. '逐行处理resultSet,筛选出男同学  
32. Sub getStudentInfo1()  
33. Dim rs       As ADODB.Recordset  
34. Dim conn     As ADODB.Connection  
35. Dim i As Integer  
36. Dim connectionString As Variant  
37. Dim maxrow&  
38. Set conn = New ADODB.Connection  
39. Set rs = New ADODB.Recordset  
40. Set xlWS = ActiveWorkbook.Worksheets("Sheet1")  
41. Select  
42. End(xlUp).Row  
43. "DSN=SCHOOL;UID=;PWD="  
44.     conn.Open connectionString  
45.       
46. "A1:F" & maxrow).ClearContents  
47.     MsgBox 1  
48. "select a.name,a.gender, b.name,c.name, d.score from student a, course b, teacher c,sc d where b.t_id=c.id and a.id=d.s_id and b.id = d.c_id", conn, adOpenStatic, adLockReadOnly  
49. '逐行处理记录集  
50. Do While Not rs.EOF  
51. If rs.Fields(1).Value = "男" Then  
52.             xlWS.Cells(maxrow + 1, 1).Value = rs.Fields(0).Value  
53.             xlWS.Cells(maxrow + 1, 2).Value = rs.Fields(1).Value  
54.             xlWS.Cells(maxrow + 1, 3).Value = rs.Fields(2).Value  
55.             xlWS.Cells(maxrow + 1, 4).Value = rs.Fields(3).Value  
56.             xlWS.Cells(maxrow + 1, 5).Value = rs.Fields(4).Value  
57.             rs.MoveNext  
58.             maxrow = maxrow + 1  
59. Else  
60.             rs.MoveNext  
61. End If  
62. Loop  
63. '更新记录  
64. "insert into student(name,gender) values('hahaha','男')"  
65. 'conn.Execute "delete from student where id=2"  
66.     rs.Close  
67. Set rs = Nothing  
68.     conn.Close  
69. Set conn = Nothing  
70. Exit Sub  
71. errhandler:  
72. ' Just exit  
73. Set connn = Nothing  
74. "Problems with database connection", vbOKOnly  
75. End Sub


本例例子和数据库文件此处可下载:adodb.zip.

手动创建透视表

为什么需要透视表呢? 上面的程序产生的结果为例,它是一个很平凡的结果集,仅仅客观的展示了学生的课程成绩.


但是如果这样显示的话更能反映问题:


或许有人喜欢这么看:


那么也就是说对于同一份数据, 不同的人基于不同的出发点, 希望从不同的角度去看它.那么这样的需求透视表可以做到.

我们先演示以上面的程序产生的学生课程成绩表为基础产生透视表,首先在第一行插入一行,添加表头: 姓名 性别 课程 老师 成绩. 然后菜单切换到Insert -> PivotTable(office2003 在Data -> PivotTable and PivotChart Report...):


第一步:框选你要创建透视图的数据, 第二步选择透视图放在哪个sheet里面的哪个位置.


然后按照你的想象尝试着把相应的数据列拖放到不同的位置,同时尝试着设置各个field的显示样式, subtotal等等.最后就可以作出如上上上图所示的透视表.

程序创建透视图

下面程序展示了怎么用vba创建pivot. 需注意的地方我都注释出来了.


[vb]  view plain copy



1. Sub createTwoPivot()  
2.     createPivotTable  
3.     createPivotTable1  
4. End Sub  
5.   
6. Sub createPivotTable()  
7. Dim connectionString As String  
8. '连接字符串  
9. "ODBC;DSN=SCHOOL;UID=;PWD=;"  
10. "Sheet2").Select  
11. '首先清空sheet数据  
12. Select  
13.     Selection.ClearContents  
14. '通过外部数据创建pivot  
15. With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)  
16.         .Connection = connectionString  
17.         .CommandType = xlCmdSql  
18.         .CommandText = Array( _  
19. "select a.name as sname,a.gender as gender, b.name as cname,c.name as tname , d.score as score from student a, course b, teacher c,sc d where b.t_id=c.id and a.id=d.s_id and b.id = d.c_id" _  
20.         )  
21. "PivotTable2"  
22. End With  
23. '次句必须  
24. Select  
25.     ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(2, 1)  
26. '把sname列放到RowField  
27. With ActiveSheet.PivotTables("PivotTable2").PivotFields("sname")  
28.         .Orientation = xlRowField  
29.         .Position = 1  
30. "姓名"  
31. End With  
32. '把gender放到RowField  
33. With ActiveSheet.PivotTables("PivotTable2").PivotFields("gender")  
34.         .Orientation = xlRowField  
35.         .Position = 2  
36. "性别"  
37. End With  
38. '把tname放到columnField  
39. With ActiveSheet.PivotTables("PivotTable2").PivotFields("tname")  
40.         .Orientation = xlColumnField  
41.         .Position = 1  
42. "老师"  
43. End With  
44. '把cname放到columnField  
45. With ActiveSheet.PivotTables("PivotTable2").PivotFields("cname")  
46.         .Orientation = xlColumnField  
47.         .Position = 2  
48. "课程"  
49. End With  
50. '把score放到DataField  
51. "PivotTable2").PivotFields("score").Orientation = xlDataField  
52. '禁止姓名列的subtotals  
53. "PivotTable2").PivotFields("姓名").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)  
54. '禁止课程列的subtotals  
55. "PivotTable2").PivotFields("课程").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)  
56. '不列出数据列  
57. False  
58. '限制列宽  
59.     ActiveSheet.Columns.ColumnWidth = 10  
60. Exit Sub  
61.      
62. errhandler:  
63. "Problems with database connection", vbOKOnly  
64. End Sub  
65.   
66.   
67. Sub createPivotTable1()  
68. Dim connectionString As String  
69. '  
70. "ODBC;DSN=SCHOOL;UID=;PWD=;"  
71. "Sheet2").Select  
72.       
73. With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)  
74.         .Connection = connectionString  
75.         .CommandType = xlCmdSql  
76.         .CommandText = Array( _  
77. "select a.name as sname,a.gender as gender, b.name as cname,c.name as tname , d.score as score from student a, course b, teacher c,sc d where b.t_id=c.id and a.id=d.s_id and b.id = d.c_id" _  
78.         )  
79. "PivotTable1"  
80. End With  
81. '词句必须, 否则报错!  
82. Select  
83.     ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(2, 9)  
84. '  
85. With ActiveSheet.PivotTables("PivotTable1").PivotFields("tname")  
86.         .Orientation = xlRowField  
87.         .Position = 1  
88. "老师"  
89. End With  
90. '  
91. With ActiveSheet.PivotTables("PivotTable1").PivotFields("cname")  
92.         .Orientation = xlRowField  
93.         .Position = 2  
94. "课程"  
95. End With  
96. '  
97. With ActiveSheet.PivotTables("PivotTable1").PivotFields("sname")  
98.         .Orientation = xlColumnField  
99.         .Position = 1  
100. "姓名"  
101. End With  
102. '  
103. With ActiveSheet.PivotTables("PivotTable1").PivotFields("gender")  
104.         .Orientation = xlColumnField  
105.         .Position = 1  
106. "性别"  
107. End With  
108. '  
109. "PivotTable1").PivotFields("score").Orientation = xlDataField  
110. '  
111. "PivotTable1").PivotFields("老师").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)  
112. '  
113. "PivotTable1").PivotFields("性别").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)  
114. '  
115. False  
116. '  
117.     ActiveSheet.Columns.ColumnWidth = 10  
118. Exit Sub  
119.      
120. errhandler:  
121. "Problems with database connection", vbOKOnly  
122. End Sub


 

至此vba excel编程三日谈到此结束, 所列内容基本满足日常需要. 希望对今天才接触vba的人入门有所帮助. 更多细节的地方, 自行google.