Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2683|回复: 3

[已解决]VBA汇总代码优化

[复制链接]
发表于 2014-11-26 17:00 | 显示全部楼层 |阅读模式
VBA汇总代码优化

这个功能是
汇总当前文件夹下,所有工作薄中 业务收入  工作表 中指定单元格的数据

到汇总工作薄 中的 汇总工作表中

代码好像不太规范,文件多时,速度也不够快

请老师们帮帮,规范下这个代码,和提下速度,谢谢老师们了!

VBA_汇总同一目录下所有工作簿指定工作表、指定单元格的数据.rar (33.63 KB, 下载次数: 4)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-11-26 17:30 | 显示全部楼层
  1. Sub Macro1()
  2. Dim mypath$$, wj$$, wb As Workbook
  3. Dim i&, j%, zf$$, arr, brr, d
  4. Application.ScreenUpdating = False
  5. Set d = CreateObject("scripting.dictionary")
  6. mypath = ThisWorkbook.Path & ""
  7. arr = Range("b1").CurrentRegion
  8. wj = Dir(mypath & "*.xls*")
  9. Do While wj <> ""
  10.     If wj <> ThisWorkbook.Name Then
  11.         With GetObject(mypath & wj)
  12.             brr = .Sheets(1).Range("b1").CurrentRegion
  13.             .Close 0
  14.         End With
  15.         For i = 5 To UBound(brr)
  16.             For j = 1 To UBound(brr, 2) Step 2
  17.                 zf = brr(i, j) & "," & i & "," & j
  18.                 d(zf) = d(zf) + brr(i, j + 1)
  19.             Next
  20.         Next
  21.     End If
  22.     wj = Dir
  23. Loop
  24. For i = 5 To UBound(arr)
  25.     For j = 1 To UBound(arr, 2) Step 2
  26.         zf = arr(i, j) & "," & i & "," & j
  27.         arr(i, j + 1) = d(zf)
  28.     Next
  29. Next
  30. Range("b1").CurrentRegion = arr
  31. Application.ScreenUpdating = True
  32. End Sub
复制代码
回复

使用道具 举报

发表于 2014-11-26 17:31 | 显示全部楼层    本楼为最佳答案   
………………

VBA_汇总同一目录下所有工作簿指定工作表、指定单元格的数据.zip

37.49 KB, 下载次数: 25

回复

使用道具 举报

 楼主| 发表于 2014-11-27 09:50 | 显示全部楼层
dsmch 发表于 2014-11-26 17:31
………………

谢谢老师的帮助!

麻烦老师再看下,下面附件中的代码规范吗,合理吗
我感觉这样的代码容易看明白点,谢谢老师了!
1.rar (33.36 KB, 下载次数: 2)

点评

楼主自己能看明白,我们是一抹黑  发表于 2014-11-27 10:05
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 18:57 , Processed in 0.329169 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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