ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[推荐] 跨工作簿汇总

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-3-3 08:31 | 显示全部楼层
感谢分享,学习了

TA的精华主题

TA的得分主题

发表于 2018-3-3 10:46 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
一指禅62老师你好!
在你的帖子基础上,增加多列汇总,麻烦看看如何修改代码。
谢谢

多列的汇总.rar

24.27 KB, 下载次数: 21

TA的精华主题

TA的得分主题

发表于 2018-3-4 08:43 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
谢谢分享                        

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-3-5 13:30 | 显示全部楼层
jjmysjg 发表于 2018-3-3 10:46
一指禅62老师你好!
在你的帖子基础上,增加多列汇总,麻烦看看如何修改代码。
谢谢

建议将两段代码对比着看:

  1. Sub 一键汇总()
  2.     Dim myPath$, f$, wb As Workbook, sh As Worksheet
  3.     Dim d As Object, temp, Arr(), n%, i%, j%, x%, S$
  4.     Dim m1, m2, m3, m4
  5.     Set d = CreateObject("Scripting.Dictionary")
  6.     myPath = ThisWorkbook.Path & ""
  7.     f = Dir(myPath & "*.xls*")
  8.     Do While f <> ""
  9.         If f <> ThisWorkbook.Name Then
  10.             Set wb = Workbooks.Open(myPath & f)
  11.             For Each sh In wb.Worksheets
  12.                 temp = sh.UsedRange
  13.                 For i = 2 To UBound(temp)
  14.                     S = temp(i, 1) & "|" & temp(i, 2) & "|" & temp(i, 3) & "|" & temp(i, 5) '判断条件
  15.                     If Not d.Exists(S) Then
  16.                         n = n + 1: ReDim Preserve Arr(1 To 8, 1 To n)
  17.                         d(S) = n
  18.                         For j = 1 To 8
  19.                             Arr(j, n) = temp(i, j)
  20.                         Next
  21.                     Else
  22.                         x = d.Item(S)
  23.                         Arr(4, x) = Arr(4, x) + temp(i, 4)  '工时
  24.                         Arr(6, x) = Arr(6, x) + temp(i, 6)  '基本
  25.                         Arr(7, x) = Arr(7, x) + temp(i, 7)  '工时单价
  26.                         Arr(8, x) = Arr(8, x) + temp(i, 8)  '工时工资
  27.                     End If
  28.                     m1 = m1 + temp(i, 4) '工时累计
  29.                     m2 = m2 + temp(i, 6) '基本累计
  30.                     m3 = m3 + temp(i, 7) '工时单价累计
  31.                     m4 = m4 + temp(i, 8) '工时工资累计
  32.                 Next
  33.             Next
  34.             wb.Close False
  35.         End If
  36.         f = Dir
  37.     Loop
  38.     Application.ScreenUpdating = False
  39.     Range("A2:H65536").Clear
  40.     If n > 0 Then
  41.         Range("A2").Resize(n, 8) = WorksheetFunction.Transpose(Arr)
  42.         Range("A" & n + 2) = "合计"
  43.         Range("B" & n + 2) = "人"
  44.         Range("D" & n + 2) = m1
  45.         Range("F" & n + 2) = m2
  46.         Range("G" & n + 2) = m3
  47.         Range("H" & n + 2) = m4
  48.         Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
  49.     End If
  50.     Application.ScreenUpdating = True
  51.     Set sh = Nothing
  52.     Set wb = Nothing
  53.     Set d = Nothing
  54. End Sub

复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-3-5 13:32 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
jjmysjg 发表于 2018-3-3 10:46
一指禅62老师你好!
在你的帖子基础上,增加多列汇总,麻烦看看如何修改代码。
谢谢

跨工作簿汇总.rar (27.04 KB, 下载次数: 81)



评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-3-6 07:03 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

谢谢老师,两个代码比较,知道规律了

TA的精华主题

TA的得分主题

发表于 2019-5-18 09:57 | 显示全部楼层
能否是当新的文件增加到此文件夹下时,当打开另外的sheet时自动会被提取

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-5-18 16:11 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
zyyxyzkwybb 发表于 2019-5-18 09:57
能否是当新的文件增加到此文件夹下时,当打开另外的sheet时自动会被提取


Worksheet_Activate 事件
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 16:43 , Processed in 0.052320 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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