在EXCLE 中利用 VBA 汇总满足一定条件的几个工作表

最新推荐文章于 2024-12-30 19:45:00 发布

okshy

最新推荐文章于 2024-12-30 19:45:00 发布

阅读量2.2k

点赞数 3

分类专栏： VBA 文章标签：工作 vba integer microsoft sql properties

本文链接：https://blog.youkuaiyun.com/okshy/article/details/5412633

版权

VBA 专栏收录该内容

6 篇文章

订阅专栏

在EXCLE 中利用 VBA 汇总满足一定条件的几个工作表

我们要完成：

要查询并汇总当前工作簿的所有班级工作表中的数学成绩在100分以上的所有学生记录

我们要用到:

1.VBA 中的ADO 和SQL;

2.VBA中的循环语句;

第一步:引用ADO对象库。

需要引用的项目如下（如果你的机器里面是另外的版本，那么就引用该版本）

Microsoft ADO Ext2.8 for DDL and Security

Microsoft Active Data Objects(Multi-dimensional) 2.8 Library

Microsoft Active Data Objects Recordset 2.8 Library

Microsoft Active Data Objects 2.8 Library

Microsoft Active Jet and Replication Objects 2.8 Library

引用的方法是:在Excel VBA 编辑器窗口中,单击【工具】菜单中的【引用】命令，打开【引用-VBAProject】对话框,勾选相应的项目即可。

第二步:把下面的代码写入“模块”中

Public Sub Search()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim myWorkName As String, n As Integer, i As Integer, sql As String

Worksheets("汇总").Cells.Clear            '清除"汇总"工作表中的所有数据
'建立与当前工作簿的连接
Set cnn = New ADODB.Connection
With cnn
    .Provider = "microsoft.jet.oledb.4.0"
    .ConnectionString = "Extended Properties=Excel 8.0;" & "Data Source=" & ThisWorkbook.FullName
    .Open
End With

'复制标题
Worksheets(2).Range("a1:iv1").Copy Destination:=Worksheets("汇总").Range("a1")

'查询各个班级工作表

For i = 1 To Worksheets.Count
If Worksheets(i).Name <> "汇总" Then '循环查找各个班级工作表

myWorkName = Worksheets(i).Name '获取班级工作表的名称

'设置SQL 语句
sql = "select*from[" & myWorkName & "$] where 数学>100"

'开始查询各个班级中符合条件的学生记录

Set rs = New ADODB.Recordset

rs.Open sql, cnn, adOpenKeyset, adLockOptimistic

'获取"汇总"工作表的最后一行

n = Worksheets("汇总").Range("a65536").End(xlUp).Row

'将查询到的学生记录复制到"汇总"工作表中

Worksheets("汇总").Range("a" & n + 1).CopyFromRecordset rs

End If

Next i
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing