vba excel编程三日谈(3)



vba excel编程三日谈(1)

vba excel编程三日谈(2)

vba excel编程三日谈(3)

本文将讲解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.     xlWS.Select  
11.     maxrow = [a65536].End(xlUp).Row  
12.     'DNS指定数据源的名称  
13.     connectionString = "DSN=SCHOOL;UID=;PWD="  
14.     conn.Open connectionString  
15.     '先清空sheet  
16.     xlWS.Range("A1:F" & maxrow + 1).ClearContents  
17.     rs.Open "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.     xlWS.Range("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.     MsgBox "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.     xlWS.Select  
42.     maxrow = [a65536].End(xlUp).Row  
43.     connectionString = "DSN=SCHOOL;UID=;PWD="  
44.     conn.Open connectionString  
45.       
46.     xlWS.Range("A1:F" & maxrow).ClearContents  
47.     MsgBox 1  
48.     rs.Open "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.     conn.Execute "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.     MsgBox "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.     connectionString = "ODBC;DSN=SCHOOL;UID=;PWD=;"  
10.     ActiveWorkbook.Worksheets("Sheet2").Select  
11.     '首先清空sheet数据  
12.     Cells.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.         .createPivotTable TableDestination:=ActiveSheet.Cells(1, 1), TableName:="PivotTable2"  
22.     End With  
23.     '次句必须  
24.     ActiveSheet.Cells(1, 1).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.         .Caption = "姓名"  
31.     End With  
32.     '把gender放到RowField  
33.     With ActiveSheet.PivotTables("PivotTable2").PivotFields("gender")  
34.         .Orientation = xlRowField  
35.         .Position = 2  
36.         .Caption = "性别"  
37.     End With  
38.     '把tname放到columnField  
39.     With ActiveSheet.PivotTables("PivotTable2").PivotFields("tname")  
40.         .Orientation = xlColumnField  
41.         .Position = 1  
42.         .Caption = "老师"  
43.     End With  
44.     '把cname放到columnField  
45.     With ActiveSheet.PivotTables("PivotTable2").PivotFields("cname")  
46.         .Orientation = xlColumnField  
47.         .Position = 2  
48.         .Caption = "课程"  
49.     End With  
50.     '把score放到DataField  
51.     ActiveSheet.PivotTables("PivotTable2").PivotFields("score").Orientation = xlDataField  
52.     '禁止姓名列的subtotals  
53.     ActiveSheet.PivotTables("PivotTable2").PivotFields("姓名").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)  
54.     '禁止课程列的subtotals  
55.     ActiveSheet.PivotTables("PivotTable2").PivotFields("课程").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)  
56.     '不列出数据列  
57.     ActiveWorkbook.ShowPivotTableFieldList = False  
58.     '限制列宽  
59.     ActiveSheet.Columns.ColumnWidth = 10  
60.     Exit Sub  
61.      
62. errhandler:  
63.     MsgBox "Problems with database connection", vbOKOnly  
64. End Sub  
65.   
66.   
67. Sub createPivotTable1()  
68.     Dim connectionString As String  
69.     '  
70.     connectionString = "ODBC;DSN=SCHOOL;UID=;PWD=;"  
71.     ActiveWorkbook.Worksheets("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.         .createPivotTable TableDestination:=ActiveSheet.Cells(1, 9), TableName:="PivotTable1"  
80.     End With  
81.     '词句必须, 否则报错!  
82.     ActiveSheet.Cells(1, 9).Select  
83.     ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(2, 9)  
84.     '  
85.     With ActiveSheet.PivotTables("PivotTable1").PivotFields("tname")  
86.         .Orientation = xlRowField  
87.         .Position = 1  
88.         .Caption = "老师"  
89.     End With  
90.     '  
91.     With ActiveSheet.PivotTables("PivotTable1").PivotFields("cname")  
92.         .Orientation = xlRowField  
93.         .Position = 2  
94.         .Caption = "课程"  
95.     End With  
96.     '  
97.     With ActiveSheet.PivotTables("PivotTable1").PivotFields("sname")  
98.         .Orientation = xlColumnField  
99.         .Position = 1  
100.         .Caption = "姓名"  
101.     End With  
102.     '  
103.     With ActiveSheet.PivotTables("PivotTable1").PivotFields("gender")  
104.         .Orientation = xlColumnField  
105.         .Position = 1  
106.         .Caption = "性别"  
107.     End With  
108.     '  
109.     ActiveSheet.PivotTables("PivotTable1").PivotFields("score").Orientation = xlDataField  
110.     '  
111.     ActiveSheet.PivotTables("PivotTable1").PivotFields("老师").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)  
112.     '  
113.     ActiveSheet.PivotTables("PivotTable1").PivotFields("性别").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)  
114.     '  
115.     ActiveWorkbook.ShowPivotTableFieldList = False  
116.     '  
117.     ActiveSheet.Columns.ColumnWidth = 10  
118.     Exit Sub  
119.      
120. errhandler:  
121.     MsgBox "Problems with database connection", vbOKOnly  
122. End Sub  

 

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