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经典代码实践指南
查看: 1023|回复: 3

[求助] 多薄内多表合并生成不重复多个表

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-5-27 14:52 | 显示全部楼层 |阅读模式
请教:将本文件夹下多个(个数不确定)工作薄内多个(个数不确定)工作表,按不重复的表名,在《汇总合并表》工作薄内新建(生成)【同名表】并合并其内容。谢谢啦!

多薄内多表合并问题.rar (28.94 KB, 下载次数: 21)

TA的精华主题

TA的得分主题

发表于 2017-5-27 16:57 | 显示全部楼层
先获取文件夹中所有的文件名,赋给一数组,循环数组,获取每一个工作表的名字,组成字典,生成新表,复制数据。
建议搜索多工作簿提取数据的帖子,有很多。

评分

参与人数 1鲜花 +2 收起 理由
鄂龙蒙 + 2 感谢帮助,提供方法,谢谢!

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-5-27 17:06 | 显示全部楼层
本帖最后由 chengshanming 于 2017-5-27 18:21 编辑
  1. 参看邮件!
复制代码

TA的精华主题

TA的得分主题

发表于 2017-5-27 18:03 | 显示全部楼层
  1. Sub 汇总()
  2.     Dim vData As Variant, nRow As Double, nCol As Integer
  3.     Dim vFill As Variant, nFill As Double
  4.     Dim dicSheet As Object
  5.     Dim sFile As String, wWB As Workbook, wSH As Worksheet
  6.    
  7.     Application.ScreenUpdating = False
  8.     Application.DisplayAlerts = False
  9.     Set dicSheet = CreateObject("Scripting.Dictionary")
  10.     sFile = "开始查找"
  11.     Do While sFile <> ""
  12.         If sFile = "开始查找" Then
  13.             sFile = Dir(ThisWorkbook.Path & "\*.xls*")
  14.         Else
  15.             If sFile <> ThisWorkbook.Name Then
  16.                 With Workbooks.Open(ThisWorkbook.Path & "" & sFile)
  17.                     For Each wSH In .Sheets
  18.                         If dicSheet.Exists(wSH.Name) Then
  19.                             vFill = dicSheet(wSH.Name)
  20.                             nFill = UBound(vFill, 2)
  21.                         Else
  22.                             vFill = Empty
  23.                             ReDim vFill(1 To 2, 1 To 1)
  24.                             nFill = 1
  25.                             vFill(1, 1) = "单位名称"
  26.                             vFill(2, 1) = "姓名"
  27.                         End If
  28.                         vData = wSH.[A1].CurrentRegion.Value
  29.                         For nRow = 2 To UBound(vData)
  30.                             nFill = nFill + 1
  31.                             ReDim Preserve vFill(1 To 2, 1 To nFill)
  32.                             For nCol = 1 To 2
  33.                                 vFill(nCol, nFill) = vData(nRow, nCol)
  34.                             Next
  35.                         Next
  36.                         dicSheet(wSH.Name) = vFill
  37.                     Next
  38.                     .Close False
  39.                 End With
  40.             End If
  41.             sFile = Dir
  42.         End If
  43.     Loop
  44.     ThisWorkbook.Activate
  45.     For Each wSH In Sheets
  46.         If wSH.Name <> "合并操作表" Then wSH.Delete
  47.     Next
  48.     If dicSheet.Count > 0 Then
  49.         vData = Empty
  50.         For Each vData In dicSheet.Keys
  51.             Sheets.Add after:=Sheets(Sheets.Count)
  52.             With ActiveSheet
  53.                 .Name = vData
  54.                 vFill = dicSheet(.Name)
  55.                 .[A1:B1].Resize(UBound(vFill, 2)) = Application.WorksheetFunction.Transpose(vFill)
  56.             End With
  57.         Next
  58.     End If
  59.     Application.DisplayAlerts = True
  60.     Application.ScreenUpdating = True
  61. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2017-5-27 18:04 | 显示全部楼层
附上附件以供参考

汇总合并表(By.Micro).rar

18.37 KB, 下载次数: 38

评分

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

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-5-27 22:04 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,高效办公专列,每天发车

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

GMT+8, 2019-10-23 14:25 , Processed in 0.071468 second(s), 14 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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