《Excel VBA+SQL数据管理与应用模板开发》_工作效率UP!_5.0 工作表快速拆分 汇总与比对

【摘要】 本书摘自《Excel VBA+SQL数据管理与应用模板开发》一书中第5章，第1节，韩小良著。

5.0 工作表快速拆分、汇总与比对

在前面的4章中，我们介绍了ADO 的基本知识和SQL 的基本语句， 本章我们结合企业实际工作中常见的一些数据处理问题介绍一些实用的 代码，让您从键盘和鼠标操作中解脱出来，只需单击按钮，即可迅速得到需要的结果。

5.1 工作表快速拆分

这类问题大家并不陌生，也会经常碰到：要从员工信息表中把各个部门的员工 信息拆分出来，另存为以部门名称为工作簿名称的新工作簿；要把 BOM 表中各种 产品的材料拆分出来，保存到新工作表中；从工资表中把每个部门的员工工资数据 拆分出来，另存为新工作簿等。

对于这样的工作，很多人的操作步骤是：筛选 → 复制一新建工作簿(工作表) 一粘贴一另存一关闭→再次筛选……如果有两三个部门、两三种产品，这样的操作 也不算费事，但是如果有几十个部门、上百种产品呢?

员工信息表的快速拆分

问题：如何从一张员工信息总表中快速把每个部门的员工信息拆分出来，并且另存为新 工作簿?

案例5-1

下面的例子就是从员工基本信息总表(见图5-1)中把各个部门的员工信息筛选出来，并另存为新工作簿，新工作簿的名称就是部门名称。

Sub拆分工作表0

Dim cnn As New ADODB.Connection

Dim rs As ADODB.Recordset

Dim ws As Worksheet

Dim wb As Workbook

Dim n As Variant,i As Integer,j As Integer

Dim sql As String

'建立与工作簿的连接

With cnn

.Provider ="microsoft.ace.oledb.12.0"

.ConnectionString="Extended Properties=Excel 12.0;"_

Source="&ThisWorkbook.FullName

.Open

End With

'获取部门名称

Sql="select distinct 部门 from[基本信息$]"

Set rs =New ADODB.Recordset

rs.Open Sql,cnn,adOpenKeyset,adLockOptimistic

n =rs.RecordCount

"将部门名称保存到数组

ReDim dept(1 To n)As String

Fori=1 To n

dept(i)=rs.Fields(0)

rs.MoveNext

Nexti

'进行查询

Fori=1Ton

'查询指定部门的数据

Sql="select*from [基本信息$]where 部门='"&dept(i)&"""

Set rs =New ADODB.Recordset

rs.Open Sql,cnn,adOpenKeyset,adLockOptimistic

'创建新工作簿

Set wb =Workbooks.Add

Set ws =wb.Worksheets(1)

'往新工作簿复制数据

With ws

'复制标题

Forj=1 To rs.Fields.Count

.Cells(1,j)=rs.Fields(j-1).Name

Next j

'复制数据

.Range("A2").CopyFromRecordset rs

'设置日期格式

.Range("H:H,J:J").NumberFormat ="yyyy-m-d"

End With

"将新工作簿另存到指定文件夹，然后关闭

wb.SaveAs Filename:=ThisWorkbook.Path&"\案例5-1明细表\"& dept(i)&".xlsx" wb.Close

Next i

MsgBox"拆分完毕!",vbInformation,"拆分工作表"

'关闭查询和连接

rs.Close

cnn.Close

Set rs =Nothing

Set cnn =Nothing

End Sub

运行程序，就得到了如图5-2所示的各个部门工作簿。

如果要按学历进行拆分，则程序可以修改如下：

Sub 拆分工作表_按学历(

Dim cnn As New ADODB.Connection

Dim rs As ADODB.Recordset

Dim ws As Worksheet

Dim wb As Workbook

Dim n As Variant,i As Integer,j As Integer

Dim sql As String

'建立与工作簿的连接

With cnn

.Provider ="microsoft.ace.oledb.12.0"

.ConnectionString="Extended Properties=Excel 12.0;"

&"Data Source="&ThisWorkbook.FullName

.Open

End With

'获取学历名称

Sql="select distinct 学 历from [基本信息$]"

Set rs =New ADODB.Recordset

rs.Open Sql,cnn,adOpenKeyset,adLockOptimistic

n=rs.RecordCount

'将学历名称保存到数组

ReDim edu(1 To n)As String

Fori=1 To n

edu(i)=rs.Fields(0)

rs.MoveNext

Next i

进行查询

Fori=1To n

'查询指定学历的数据

Sql="select*from [基本信息$]where 学历="&edu(i)&""

Set rs =New ADODB.Recordset

rs.Open Sql,cnn,adOpenKeyset,adLockOptimistic

'创建新工作簿

Set wb=Workbooks.Add

Set ws =wb.Worksheets(1)

'往新工作簿复制数据

With ws

'复制标题

For j=1 To rs.Fields.Count

.Cells(1,j)=rs.Fields(j -1).Name

Next j

'复制数据

.Range("A2").CopyFromRecordset rs

'设置日期格式

.Range("H:H,J:J").NumberFormat ="yyyy-m-d"

End With

"将新工作簿另存到指定文件夹，然后关闭

wb.SaveAs Filename:=This Workbook.Path&"案例5-1明细表\"&edu(i)&".xlsx"

wb.Close

Next i

MsgBox"拆分完毕!",vbInformation,"拆分工作表"

'关闭查询和连接

rs.Close

cnn.Close

Set rs =Nothing

Set cnn =Nothing

End Sub

5.1.2 工资表的快速拆分

问题：如何从工资总表中按照部门拆分成各个部门的工资表，并保存在新工作表中?

这个程序的设计与上面的大同小异，唯一的区别就是要插入新工作表。

案例5-2

下面的例子就是从工资表中筛选出各个部门的员工工资，并保存到新工作表中，新工作表的名称就是部门名称。

版权声明：本文内容由网络用户投稿，版权归原作者所有，本站不拥有其著作权，亦不承担相应法律责任。如果您发现本站中有涉嫌抄袭或描述失实的内容，请联系我们 18664393530@aliyun.com 处理，核实后本网站将在24小时内删除侵权内容。