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经典代码实践指南
楼主: opiona

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

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2016-8-13 06:41 | 显示全部楼层
进来学习了。

TA的精华主题

TA的得分主题

发表于 2016-9-24 18:52 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2016-9-25 11:06 | 显示全部楼层
opiona 发表于 2014-12-3 23:31
SQL语句有限制,工作表太多要找个地方存中间数据
然后再求和等分类汇总,见附件模块2:

老师你好,用你的代码测试,经常会出现下标越界这种情况,查了很多资料,也不知道如何修改代码。还请老师看见后回复一下,谢谢!

TA的精华主题

TA的得分主题

发表于 2016-9-25 12:23 | 显示全部楼层
Sub Opiona()

'On Error Resume Next    '// 发生错误,自动执行下一句,就是忽略错误
Application.ScreenUpdating = False '//关闭屏幕刷新
Application.DisplayAlerts = False '//关闭系统提示
t = Timer   '//开始时间

    Set SH0 = Sheets("汇总")
    SH0.Range("A5:H65536").ClearContents
   
    FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
    For I = 0 To UBound(FileArr)
            Str_coon = "HDR=yes';Data Source =" & FileArr(I)    '//OFFICE2003,2007 通用
            NameArr = GET_NameSheets(Str_coon)
            
            For n = 0 To UBound(NameArr)   '//循环所有工作表
                If StrSQL <> "" Then StrSQL = StrSQL & "union all"
                StrSQL = StrSQL & "select 站点,单量 from [" & NameArr(n) & "$A:b]"
            
          Next n
    Next I
StrSQL1 = "SELECT 站点,SUM(单量) as 单量 FROM (" & StrSQL & ") GROUP BY 站点 ORDER BY 站点"
SQLARR = GET_SQL_To_Arr(StrSQL1, Str_coon, True)
SH0.Range("A2").Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR
Application.ScreenUpdating = True '//恢复屏幕刷新
Application.DisplayAlerts = True '//恢复系统提示
MsgBox "一共用时:" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
End Sub

老师你好,我想汇总同一文件夹下,不同工作簿的所有工作表,工作簿的工作表数不一样,有的工作簿3个工作表,有的工作簿2个工作表。我按照老师提供的代码,进行了改写,但是提示下标越界,标红的部分。代码如上,还请老师指点一二。附件也会上传,谢谢了。

TA的精华主题

TA的得分主题

发表于 2016-9-25 12:28 | 显示全部楼层
本帖最后由 送人亲 于 2016-9-25 13:01 编辑

附件已经上传了,麻烦老师看一下

实验.rar

58.23 KB, 下载次数: 13

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-9-25 21:03 | 显示全部楼层
你这种情况,最好先汇总到一个临时表中(复制)
然后用临时表再:分类汇总

附件中代码可以用,但是如果
  1. Sub Opiona()

  2. 'On Error Resume Next    '// 发生错误,自动执行下一句,就是忽略错误
  3. Application.ScreenUpdating = False '//关闭屏幕刷新
  4. Application.DisplayAlerts = False '//关闭系统提示
  5. t = Timer   '//开始时间

  6.     Set SH0 = Sheets("汇总")
  7.     SH0.Range("A2:H65536").ClearContents
  8.    
  9.     FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
  10.     Str_coon = "HDR=yes';Data Source =" & ThisWorkbook.FullName    '//OFFICE2003,2007 通用
  11.     For I = 0 To UBound(FileArr)
  12.             Str_xxxx = "HDR=yes';Data Source =" & FileArr(I)     '//OFFICE2003,2007 通用
  13.             NameArr = GET_NameSheets(Str_xxxx)
  14.             For n = 0 To UBound(NameArr)   '//循环所有工作表
  15.             
  16.                 If StrSQL <> "" Then StrSQL = StrSQL & " union all "  '//这里前后有空格
  17.                 StrSQL = StrSQL & "select 站点,单量 from [Excel 12.0;HDR=YES;Database=" & FileArr(I) & "].[" & NameArr(n) & "$]"
  18.             
  19.           Next n
  20.     Next I
  21.    
  22. StrSQL1 = "SELECT 站点,SUM(单量) as 单量 FROM (" & StrSQL & ") GROUP BY 站点 ORDER BY 站点"
  23. SQLARR = GET_SQL_To_Arr(StrSQL1, Str_coon, False)

  24. 'MsgBox StrSQL1
  25. SH0.Range("A2").Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR
  26. Application.ScreenUpdating = True '//恢复屏幕刷新
  27. Application.DisplayAlerts = True '//恢复系统提示
  28. MsgBox "一共用时:" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
  29. End Sub
复制代码
文件或工作表多了,就可能出错!

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-9-25 21:10 | 显示全部楼层
下面是标准一点的
不限文件数量,不限工作表个数

  1. Sub 标准汇总方式()

  2. 'On Error Resume Next    '// 发生错误,自动执行下一句,就是忽略错误
  3. Application.ScreenUpdating = False '//关闭屏幕刷新
  4. Application.DisplayAlerts = False '//关闭系统提示
  5. t = Timer   '//开始时间
  6.   
  7.     Set SHX = Sheets("TEMPXX")
  8.     SHX.Range("A2:D1048576").ClearContents
  9.    
  10.     FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
  11.     For I = 0 To UBound(FileArr)
  12.    
  13.         Str_coon = "HDR=yes';Data Source =" & FileArr(I)    '//OFFICE2003,2007 通用
  14.         NameArr = GET_NameSheets(Str_coon)
  15.         For N = 0 To UBound(NameArr)
  16.             StrSQL = "SELECT 站点,单量"
  17.             StrSQL = StrSQL & ",'" & NameArr(N) & "' AS  工作表"
  18.             StrSQL = StrSQL & ",'" & GetPathFromFileName(FileArr(I)) & "' AS  工作簿"
  19.             StrSQL = StrSQL & " FROM [" & NameArr(N) & "$]"
  20.             IROW = SHX.Range("A1048576").End(3).Row + 1
  21.             SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
  22.             SHX.Range("A" & IROW).Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR '//(0 TO X)的数组行列都要+1,(1 TO X) 的不要
  23.         Next N
  24.    
  25.     Next I

  26.     Set SH0 = Sheets("汇总")
  27.     SH0.Range("A2:B1048576").ClearContents
  28.    
  29.     StrSQL = "SELECT 站点,SUM(单量) as 单量 FROM [" & SHX.Name & "$] GROUP BY 站点 ORDER BY 站点"
  30.     Str_coon = "HDR=yes';Data Source=" & ThisWorkbook.FullName
  31.     SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
  32.    
  33.     'MsgBox StrSQL
  34.     SH0.Range("A2").Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR

  35. Application.ScreenUpdating = True '//恢复屏幕刷新
  36. Application.DisplayAlerts = True '//恢复系统提示
  37. MsgBox "一共用时:" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
  38. End Sub
复制代码

评分

参与人数 1鲜花 +2 收起 理由
送人亲 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-9-25 21:11 | 显示全部楼层
标准实验.rar (57.88 KB, 下载次数: 187)

评分

参与人数 1鲜花 +2 收起 理由
liu1913 + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

发表于 2016-9-25 23:16 | 显示全部楼层

老师,你好,附件已经测试,可以使用,非常感谢!
还有您提到,如果文件或工作表多的话会出错,那么您提供的标准代码可以解决这个问题吗?再次打扰了

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-9-26 17:21 | 显示全部楼层
送人亲 发表于 2016-9-25 23:16
老师,你好,附件已经测试,可以使用,非常感谢!
还有您提到,如果文件或工作表多的话会出错,那么您提 ...

对的,是这样子!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

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

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

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

GMT+8, 2019-10-24 11:09 , Processed in 0.076104 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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