遍历指定文件夹多个excel文件，读取文件名和文件中某几个位置的数据到汇总表

yanono · 发表于 2010-7-15 19:15

我需要从很多个（上百）excel文件中，遍历读取所有文件名和多个指定单元格数据。
举个例子，医院把每年来体检的人的体检信息都以人名保存成单独的excel文件，每个excel文件都有若干个sheet工作表（各项检测指标，如心电、血脂等）。我现在要汇总一段时期内某几项指标的具体数值，在一个新的excel内以下面的形式显示：

序号姓名体检日期血压总胆固醇甘油三酯其它略

我用VB也只会自己录制宏然后从里面复制，请大家帮我给个快捷的解决方法，最后是不要在前台一一打开各个文件。

hupanshan · 发表于 2010-7-15 19:46

样式.rar (22.07 KB, 下载次数: 1897)

yanono · 发表于 2010-7-16 19:00

非常感谢hupanshan的解答。
您的代码我正在研究学习中，我需要的是每个文件中的几个数据，不是全部的数据。我先自己改代码，不行的话再请教。

这2天我自己琢磨的笨办法是建个.bat文件，放在文件夹里，运行tree命令输出文本来得到全部文件的名称，然后导入excel中（这个过程也可以在excel中调用run命令完成吧？我没有研究），然后用&方法合并成完整路径，但是不会以批量以公式输入来引用，单个手动输入可以。例如
Range("h10") = "='D:\报告\[王强.xlsx]体检报告'!$W$10"
我把引用路径换成变量或者引用单元格里输好的文本路径，就不行了，输出成文本了。

我VBA还算不上入门，虽然有思路，也知道有命令语句来实现我的思路，但查看帮助文件和网络求助还不会很正确的搜索方法，很难找到适合自己的答案。

hupanshan · 发表于 2010-7-16 19:31

指定位置汇总.rar (193.17 KB, 下载次数: 2123)

yanono · 发表于 2010-7-16 21:42

您的第一个附件我学习了一下，但有很多不明白的地方，百度不到，希望能指点一下。

Private Sub CommandButton1_Click()
Set cnn = CreateObject("adodb.connection")
'定义cnn为一个什么类型的数据库数据？
[a2:i65536].ClearContents
'清空指定范围数据
h = 2
'给变量h赋值为2
f = Dir(ThisWorkbook.Path & "\*.xls")
'给变量f赋值为本文件夹下所有.xls文件
Do While f > " "
'判断f，直到f返回值不满足＞0长度字节段的条件，则停止循环
      If f <> ThisWorkbook.Name Then
      '判断，当f与当前运行代码的excel文件名不相同，则
         cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "\" & f
         '这个是说用参数指定的数据库工具、程序、路径去打开f满足条件时指向的文件吧？open后面的双引号和那个配对的？
         Sql = "select * from [端子端口详情$]"
         '数据取值为f指向文件的[端子端口详情]表的select*范围，这个$是什么作用呢？
         Cells(h, 2).CopyFromRecordset cnn.Execute(Sql)
         '在[2，2]处粘贴cnn。（这里直接b2不行吗？是不是cells的行列参数只认数字？）
         ed = [b65536].End(3).Row + 1
         '这个是数值？一个单元格位置？一个区域？这句目的应该是是为下句输文件名定范围，但怎么实现的看不懂。end（3）什么意思？
         Cells(h, 1).Resize(ed - h, 1) = f
         '在指定范围输入f指向的文件名。
         h = ed
         '重新给h赋值为ed。
         cnn.Close
         '断开cnn的链接
      End If
      '循环结束
      f = Dir
      '再次调用dir命令。dir怎么这么聪明，按顺序不重复，不遗漏？如果dir的时候文件夹排序动一下呢？
Loop
'循环退出
End Sub

hupanshan · 发表于 2010-7-18 14:57

Private Sub CommandButton1_Click()
Set cnn = CreateObject("adodb.connection")
'令cnn表示新设的ADODB.Connection对象。我一般很少定义变量，如果定义的话Dim cnn As ADODB.Connection
[a2:i65536].ClearContents
'清空指定范围数据
h = 2
'给变量h赋值为2
f = Dir(ThisWorkbook.Path & "\*.xls")
'给变量f赋值为本文件夹下用dir函数取得的第一个.xls文件名
Do While f > " "
'判断f，直到f返回值不满足＞一个空格的条件，则停止循环
      If f <> ThisWorkbook.Name Then
      '判断，当f与当前运行代码的excel文件名不相同，则
         cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "\" & f
         '打开ADO连接到指定文件，第一组双引号之间先照抄吧。
         Sql = "select * from [端子端口详情$]"
         '这个$是规定，先照抄吧
         Cells(h, 2).CopyFromRecordset cnn.Execute(Sql)
         '在[2，2]处粘贴cnn。（如果只导入一个文件的数据，可以用[b2]）
         ed = [b65536].End(3).Row + 1
         '找B65536往上第一个有数据的行加1作为下次导入数据的位置。更完整的写法ed = [b65536].End(Xlup).Row + 1
         Cells(h, 1).Resize(ed - h, 1) = f
         '在指定范围输入f指向的文件名。
         h = ed
         '重新给h赋值为ed。
         cnn.Close
         '断开cnn的链接
      End If
      '循环结束
      f = Dir
      '这也是规定，就这样写就可以。因为本程序操作不涉及文件的增删，所以不会发生读取文件名的错误
Loop
'循环退出
End Sub

yanono · 发表于 2010-7-18 17:21

非常感谢！不过我又遇到了新问题，请下载附件查看。

hupanshan · 发表于 2010-7-19 11:14

最好的解决方法是把文件格式统一

ROCK@ · 发表于 2010-7-19 11:57

请高手帮我做个宏哦附件中的问题表有三个表,表一是数据表,表二是费用明细表,表三是汇总表,根据表一和表二的数据按相同项目汇总到表三,当表一的B列(名称)和表三的A列(项目)的名字相同时,并且表一的G2(月份)和表三的第一行的月份相同时,把表一的数据复制到表三,比如6月,厚豆腐,:表二的B列(二级科目)的名字和表三的表三的A列(项目)的名字相同时,并且表二的F1(月份)和表三的第一行的月份相同时,把表一的数据复制到表三

yanono · 发表于 2010-7-19 16:49

9楼的问题貌似可以用数据透视表解决，也可以定义名称并用条件格式来解决，没必要编写宏。

我的水平还在初级之外，我只是猜测解决方法。

无知者无畏。

===============================

你的描述误导了我，你说的问题表有3个表。。。应该是问题表文件夹里有3个工作薄。

[ 本帖最后由 yanono 于 2010-7-19 17:19 编辑 ]

		自动登录	找回密码
密码			免费注册

[求助] 遍历指定文件夹多个excel文件，读取文件名和文件中某几个位置的数据到汇总表

参考

评分

参考

评分

回复 8楼 hupanshan 的帖子