ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 832|回复: 5

[已解决] 求大神帮我把这段代码改一下

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-1-19 21:59 | 显示全部楼层 |阅读模式
本帖最后由 aecn 于 2019-1-21 21:22 编辑

这段汇总代码是在论坛里找的,是汇总根目录下的.xls表格的数据,求大神帮改成指定子目录  /12月/ 文件夹里所有的EXCEL表格(包括.xls .xlsx .xlsm)的数据
特别需要,但自己能力有限,在此先谢谢各位大神了。
  1. Sub ADO法()
  2. Dim Fso As Object, File As Object, cnn As Object, RS As Object, sql$, n&, arr, brr(), i&
  3. Application.ScreenUpdating = False
  4. arr = [{"A5:A5","B5:B5","C5:C5","D5:D5","E5:E5","F5:F5","G5:G5","H5:H5","I5:I5","J5:J5","K5:K5","L5:L5","F27:F27","F28:F28","F30:F30","F32:F32","F33:F33"}]
  5. Set Fso = CreateObject("Scripting.FileSystemObject")
  6. ReDim brr(1 To Fso.GetFolder(ThisWorkbook.Path).Files.Count, 1 To 17)
  7. Set cnn = CreateObject("adodb.connection")
  8. For Each File In Fso.GetFolder(ThisWorkbook.Path).Files
  9. If File.Name Like "*.xls" Then
  10. n = n + 1
  11. If n = 1 Then cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & File
  12. For i = 1 To 17
  13. sql = "select f1 from [Excel 12.0;hdr=no;Database=" & File & ";].[数据[        DISCUZ_CODE_0        ]quot; & arr(i) & "]"  '名为“数据”的工作表
  14. Set RS = cnn.Execute(sql)
  15. brr(n, i) = RS.Fields(0)
  16. Next
  17. End If
  18. Next
  19. Sheet1.Range("A4:Q5000").ClearContents
  20. Range("A4").Resize(n, 17) = brr
  21. RS.Close
  22. cnn.Close
  23. Set RS = Nothing
  24. Set cnn = Nothing
  25. Set Fso = Nothing
  26. Application.ScreenUpdating = True
  27. End Sub
复制代码


数据汇总.rar

40.05 KB, 下载次数: 2

TA的精华主题

TA的得分主题

发表于 2019-1-19 22:31 | 显示全部楼层
建议上传附件来参照修改  否则还有问题你还得来追问

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-19 23:33 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
abc123281 发表于 2019-1-19 22:31
建议上传附件来参照修改  否则还有问题你还得来追问

附件已上传,汇总.xlsm 这个文件 必须放到“12月”这个子文件夹里才能汇总,也只能.xls的EXCEL文件
求大神帮忙改改
头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2019-1-20 08:29 | 显示全部楼层
头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2019-1-20 08:29 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-20 09:43 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
朱荣兴 发表于 2019-1-20 08:29
对比一下这两句代码就明白了
For Each File In Fso.GetFolder(ThisWorkbook.Path & "\12月\").Files
     ...

完善解决,谢谢朱老师。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 15:17 , Processed in 0.038592 second(s), 14 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表