ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 56962|回复: 445

[原创] 工作簿汇总,工作表汇总合并,多文件汇总合并 通用代码 支持多层子文件夹

    [复制链接]

TA的精华主题

TA的得分主题

发表于 2018-4-20 17:06 | 显示全部楼层 |阅读模式
本帖最后由 opiona 于 2018-4-24 09:36 编辑

看到论坛求助汇总的贴子很多,总结了几种情况
只做了比较通用的代码和大家分享(完全通用是不可能的)

看上去代码多,是因为几个自定义函数
这个是个人习惯:将常用的做成函数或过程,用时只要填几个参数就OK了
其中:获取文件清单函数:支持多种选项,支持多层子文件夹

1_单工作簿内多工作表,指定几个位置的数据汇总
数据在一个工作簿内,但是工作簿内有多个相同格式和标题的工作表
需要每个工作表,几个固定位置的数据

1_单工作簿内多工作表,指定几个位置的数据汇总.rar (29.53 KB, 下载次数: 7264)

评分

参与人数 110财富 +20 鲜花 +215 收起 理由
Tjdxfeng + 2
FOB_FN_L + 2 值得肯定
simba999 + 2 优秀作品
anglefire2103 + 1 太强大了
ardu95 + 2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-4-23 10:34 | 显示全部楼层
新时代新征途 发表于 2018-4-20 21:43
opiona老师好!您发的汇总有很大的用处,太好了!谢谢您了!但是,我在测试时,3、4、5、6、7 ...

ADO程序没安装吧
需要安装:Access 或者安装插件:AccessDatabaseEngine

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-4-29 18:30 来自手机 | 显示全部楼层
ADO程序没安装吧
需要安装:Access 或者安装插件:AccessDatabaseEngine

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-5-5 08:48 | 显示全部楼层
ansen__111 发表于 2018-5-4 17:03
总公司设计了一套excel工作表,在一个工作簿中,每个工作表的行是所有下属公司名称(比如a1是北京公司,a2 ...

14885553.rar (248.73 KB, 下载次数: 349)

评分

参与人数 1鲜花 +2 收起 理由
ansen__111 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-5-8 13:29 | 显示全部楼层
djs5212720 发表于 2018-5-8 08:43
5_多工作簿指定工作表,全部数据汇总,运行时时发现越界报错-9
请问老师这会是什么引起的报错!
Dim T

Set SH1 = Sheets("汇总")   这里报错
改成:Set SH1 = workSheets("汇总")    '//试试

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-5-9 09:36 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-5-30 14:38 | 显示全部楼层
实例 都是不累加的(就是非汇总)
支持子文件夹,而且多层子文件夹 也行啊!

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-6-6 13:18 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-6-16 18:15 | 显示全部楼层
zqxhuaxin 发表于 2018-6-16 17:19
十分感谢,有个小问题,我的工作簿都包含链接,每次打开都会弹出是否更新链接,一个一个点“不更新”或者关 ...
  1. Sub Opiona()
  2.    
  3.      Rem 禁止系统刷屏?触发其他事件等
  4.     'On Error Resume Next    '// 发生错误,自动执行下一句,就是忽略错误
  5.     Application.ScreenUpdating = False '//关闭屏幕刷新
  6.     Application.DisplayAlerts = False '//关闭系统提示
  7.     Application.EnableEvents = False  '//禁止触发其他事件
  8.     Application.StatusBar = True   '关闭系统状态条
  9.     Application.Calculation = xlManual     '//xlCalculationManual  用户请求时进行计算


  10.     Dim T
  11.     T = Timer   '//开始时间

  12.     Rem  提示信息,在状态栏显示
  13.     Rem Application.StatusBar = "文件总数:" & ICINT & " 当前是第:" & I + 1 & " 当前提取的文件是:" & GetPathFromFileName(FileArr(I), True)  '
  14.     Rem  DoEvents

  15.     Application.Calculation = xlAutomatic  '//xlCalculationAutomaticExcel 控制重新计算。
  16.     Application.StatusBar = False   '恢复系统状态条
  17.     Application.EnableEvents = True  '//  '//恢复触发其他事件
  18.     Application.ScreenUpdating = True '//恢复屏幕刷新
  19.     Application.DisplayAlerts = True '//恢复系统提示
  20.     MsgBox "一共用时:" & Format(Timer - T, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
复制代码

评分

参与人数 1鲜花 +2 收起 理由
zqxhuaxin + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-6-16 19:59 | 显示全部楼层
Sub 打开含有链接的文件() '先屏蔽更新对话框/文件打开后要恢复(以避免影响其他文件的链接提示)
   Application.AskToUpdateLinks = False  '//先屏蔽更新对话框
         Workbooks.Open ("有链接的文件.xls")
   Application.AskToUpdateLinks = True   '//先屏蔽恢复更新对话框
End Sub
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

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

GMT+8, 2019-11-17 12:58 , Processed in 0.122093 second(s), 17 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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