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:

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

Sub getStudentInfo() Dim rs As ADODB.Recordset Dim conn As ADODB.Connection Dim i As Integer Dim connectionString As Variant Dim maxrow& Set conn = New ADODB.Connection Set rs = New ADODB.Recordset Set xlWS = ActiveWorkbook.Worksheets("Sheet1") xlWS.Select maxrow = [a65536].End(xlUp).Row 'DNS指定数据源的名称 connectionString = "DSN=SCHOOL;UID=;PWD=" conn.Open connectionString '先清空sheet xlWS.Range("A1:F" & maxrow + 1).ClearContents 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 'copy 结果集到sheet,从指定的range开始 xlWS.Range("A1").CopyFromRecordset rs rs.Close Set rs = Nothing conn.Close Set conn = Nothing Exit Sub errhandler: ' Just exit Set connn = Nothing MsgBox "Problems with database connection", vbOKOnly End Sub '逐行处理resultSet,筛选出男同学 Sub getStudentInfo1() Dim rs As ADODB.Recordset Dim conn As ADODB.Connection Dim i As Integer Dim connectionString As Variant Dim maxrow& Set conn = New ADODB.Connection Set rs = New ADODB.Recordset Set xlWS = ActiveWorkbook.Worksheets("Sheet1") xlWS.Select maxrow = [a65536].End(xlUp).Row connectionString = "DSN=SCHOOL;UID=;PWD=" conn.Open connectionString xlWS.Range("A1:F" & maxrow).ClearContents MsgBox 1 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 '逐行处理记录集 Do While Not rs.EOF If rs.Fields(1).Value = "男" Then xlWS.Cells(maxrow + 1, 1).Value = rs.Fields(0).Value xlWS.Cells(maxrow + 1, 2).Value = rs.Fields(1).Value xlWS.Cells(maxrow + 1, 3).Value = rs.Fields(2).Value xlWS.Cells(maxrow + 1, 4).Value = rs.Fields(3).Value xlWS.Cells(maxrow + 1, 5).Value = rs.Fields(4).Value rs.MoveNext maxrow = maxrow + 1 Else rs.MoveNext End If Loop '更新记录 conn.Execute "insert into student(name,gender) values('hahaha','男')" 'conn.Execute "delete from student where id=2" rs.Close Set rs = Nothing conn.Close Set conn = Nothing Exit Sub errhandler: ' Just exit Set connn = Nothing MsgBox "Problems with database connection", vbOKOnly End Sub

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

手动创建透视表

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

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

或许有人喜欢这么看:

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

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

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

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

程序创建透视图

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

Sub createTwoPivot() createPivotTable createPivotTable1 End Sub Sub createPivotTable() Dim connectionString As String '连接字符串 connectionString = "ODBC;DSN=SCHOOL;UID=;PWD=;" ActiveWorkbook.Worksheets("Sheet2").Select '首先清空sheet数据 Cells.Select Selection.ClearContents '通过外部数据创建pivot With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal) .Connection = connectionString .CommandType = xlCmdSql .CommandText = Array( _ "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" _ ) .createPivotTable TableDestination:=ActiveSheet.Cells(1, 1), TableName:="PivotTable2" End With '次句必须 ActiveSheet.Cells(1, 1).Select ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(2, 1) '把sname列放到RowField With ActiveSheet.PivotTables("PivotTable2").PivotFields("sname") .Orientation = xlRowField .Position = 1 .Caption = "姓名" End With '把gender放到RowField With ActiveSheet.PivotTables("PivotTable2").PivotFields("gender") .Orientation = xlRowField .Position = 2 .Caption = "性别" End With '把tname放到columnField With ActiveSheet.PivotTables("PivotTable2").PivotFields("tname") .Orientation = xlColumnField .Position = 1 .Caption = "老师" End With '把cname放到columnField With ActiveSheet.PivotTables("PivotTable2").PivotFields("cname") .Orientation = xlColumnField .Position = 2 .Caption = "课程" End With '把score放到DataField ActiveSheet.PivotTables("PivotTable2").PivotFields("score").Orientation = xlDataField '禁止姓名列的subtotals ActiveSheet.PivotTables("PivotTable2").PivotFields("姓名").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) '禁止课程列的subtotals ActiveSheet.PivotTables("PivotTable2").PivotFields("课程").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) '不列出数据列 ActiveWorkbook.ShowPivotTableFieldList = False '限制列宽 ActiveSheet.Columns.ColumnWidth = 10 Exit Sub errhandler: MsgBox "Problems with database connection", vbOKOnly End Sub Sub createPivotTable1() Dim connectionString As String ' connectionString = "ODBC;DSN=SCHOOL;UID=;PWD=;" ActiveWorkbook.Worksheets("Sheet2").Select With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal) .Connection = connectionString .CommandType = xlCmdSql .CommandText = Array( _ "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" _ ) .createPivotTable TableDestination:=ActiveSheet.Cells(1, 9), TableName:="PivotTable1" End With '词句必须, 否则报错! ActiveSheet.Cells(1, 9).Select ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(2, 9) ' With ActiveSheet.PivotTables("PivotTable1").PivotFields("tname") .Orientation = xlRowField .Position = 1 .Caption = "老师" End With ' With ActiveSheet.PivotTables("PivotTable1").PivotFields("cname") .Orientation = xlRowField .Position = 2 .Caption = "课程" End With ' With ActiveSheet.PivotTables("PivotTable1").PivotFields("sname") .Orientation = xlColumnField .Position = 1 .Caption = "姓名" End With ' With ActiveSheet.PivotTables("PivotTable1").PivotFields("gender") .Orientation = xlColumnField .Position = 1 .Caption = "性别" End With ' ActiveSheet.PivotTables("PivotTable1").PivotFields("score").Orientation = xlDataField ' ActiveSheet.PivotTables("PivotTable1").PivotFields("老师").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) ' ActiveSheet.PivotTables("PivotTable1").PivotFields("性别").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) ' ActiveWorkbook.ShowPivotTableFieldList = False ' ActiveSheet.Columns.ColumnWidth = 10 Exit Sub errhandler: MsgBox "Problems with database connection", vbOKOnly End Sub

 

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