Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

你正在寻找更好的Excel学习教程吗?Excel技巧80集+数据透视表+函数初中高全套+VBA80集,想学的这儿全都有
查看: 116|回复: 3

[求助] 多表格数据汇总-急急急,在线等

[复制链接]
发表于 2017-10-12 15:44 | 显示全部楼层 |阅读模式
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
多个表格的数据要汇总到一个表格里,详细如附件,还请高手帮帮忙,表格有1000+,急急急,在线等

求助多表格内容汇总.rar

220.43 KB, 下载次数: 11

 楼主| 发表于 2017-10-12 16:21 | 显示全部楼层
回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-10-12 20:52 | 显示全部楼层
回复 支持 反对

使用道具 举报

发表于 2017-10-23 09:30 | 显示全部楼层
  1. Sub yy()
  2. Application.ScreenUpdating = False
  3. Dim aw As Workbook, k%, rg As Range, s$, r$
  4. Dim arr, m%, rw%
  5.   Set aw = ThisWorkbook
  6.   aw.Sheets("汇总表").[A:c] = ""
  7.   aw.Sheets("汇总表").Range(Cells(1, 1), Cells(1, 3)) = Array("表名", "名字1", "名字2")
  8.    
  9.       '以下遍历文件,提取各单数据
  10.   p = aw.Path & ""
  11.   f = Dir(p & "*.xls")
  12.   Do While f <> ""
  13.     If f <> ThisWorkbook.Name Then
  14.         Set wk = GetObject(p & f)
  15.         wk.Sheets("4").Activate
  16.         Set rg = wk.Sheets("4").[a:a].Find("名字1")
  17.         k = rg.CurrentRegion.Rows.Count
  18.         arr = rg.Offset(1, 1).Resize(k - rg.Row + 1, 2)
  19.         rw = aw.Sheets("汇总表").[b65536].End(3).Row
  20.         r = wk.Name
  21.         w = InStr(wk.Name, ".")
  22.         s = Left(wk.Name, w - 1)
  23.         MsgBox s
  24.         aw.Sheets("汇总表").Range("a" & rw + 1 & ":a" & UBound(arr) + rw).Value = s
  25.         aw.Sheets("汇总表").Range("b" & rw + 1).Resize(UBound(arr), 2) = arr
  26.         wk.Close False
  27.      End If
  28.       f = Dir
  29.   Loop
  30.       m = aw.Sheets("汇总表").[b65536].End(3).Row
  31.         
  32.    With aw.Sheets("汇总表").Range(Cells(1, 1), Cells(m, 3)).Borders
  33.      .LineStyle = xlContinuous
  34.      .ColorIndex = 0
  35.      .TintAndShade = 0
  36.      .Weight = xlThin
  37.    End With
  38.    aw.Sheets("汇总表").[A:c].Columns.AutoFit
  39.    
  40. Application.ScreenUpdating = True
  41. MsgBox "汇总完毕!"
  42. End Sub 多表格数据汇总-急急急.rar (230.74 KB, 下载次数: 1)
复制代码
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2018-1-19 21:31 , Processed in 0.051201 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

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