用SQL汇总或合并工作表、工作簿和跨文件夹和工作表汇总

opiona · 发表于 2018-4-18 15:41

Set SHX = Worksheets("汇总")
SHX.Range("A5:HZ1048576").ClearContents
Rem 获取各个分表清单
FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
ICINT = UBound(FileArr) + 1
For I = 0 To UBound(FileArr)
Rem 提示信息，在状态栏显示
Application.StatusBar = "文件总数：" & ICINT & " 当前是第：" & I + 1 & " 当前提取的文件是：" & GetPathFromFileName(FileArr(I), True) '
DoEvents
Rem 打开分表
Set WB = Workbooks.Open(FileArr(I))
Rem 找到对应表格
For Each SH In WB.Worksheets
If SH.Name = SHX.Range("B1").Value Then
Rem 写入文件名
SHX.Cells(I + 5, 1).Value = GetPathFromFileName(FileArr(I))
Rem 找到需要的单元格位置
For ICOL = 2 To SHX.Range("HZ4").End(xlToLeft).Column
If Len(SHX.Cells(3, ICOL).Value) > 0 Then
SHX.Cells(I + 5, ICOL).Value = SH.Range(SHX.Cells(3, ICOL).Value).Value
End If
Next
Exit For
End If
Next SH
WB.Close False
Set WB = Nothing
Next I

复制代码

opiona · 发表于 2018-4-18 15:44

shibin1126 发表于 2018-4-18 13:24
请问老师，像我附件中第一页和第三页中（黄色单元格）内容，代码该怎么改啊？位置什么都是固定的。麻烦 ...

黄色位置 B1 指明数据在哪个工作表中第3行单元格位置：填写数据都在哪些单元格中，可填写多个
QQ截图20180418154151.jpg

气体检测改.rar (148.72 KB, 下载次数: 76)

opiona · 发表于 2018-4-18 15:48

可以增加多个汇总内容

QQ截图20180418154151.jpg

气体检测改.rar (148.72 KB, 下载次数: 89)

teshia · 发表于 2018-4-19 22:40

非常棒

麻烦兄弟帮我看下这个帖子怎么汇总
我原来的方法可以汇总，但是每个月人员都会有变动，不是固定到127行，要改数字，不灵活

http://club.excelhome.net/forum. ... p;page=1#pid9480266

opiona · 发表于 2018-4-20 10:24

teshia 发表于 2018-4-19 22:40
非常棒

麻烦兄弟帮我看下这个帖子怎么汇总

qihang15 · 发表于 2018-5-7 19:29

谢谢分享，学习一下。

huazai688 · 发表于 2018-6-26 22:40

做个记号学习一下

liu1913 · 发表于 2018-7-24 11:39

大师，能帮忙回复下62楼不

juekasry · 发表于 2018-8-16 10:44

收益匪浅~！谢谢分享！

烦请大神看看我这个，一调试就出问题，不知道那个地方出错咯

opiona · 发表于 2018-8-16 18:10

5_多工作簿指定工作表，全部数据汇总
http://club.excelhome.net/thread-1409141-1-1.html

改一下设置，如图：

		自动登录	找回密码
密码			免费注册

[分享] 用SQL汇总或合并工作表、工作簿和跨文件夹和工作表汇总