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

opiona

看到很多汇总需求，但是大多数是字典解决的，
我提供一个SQL的方法，最然不是最快的，是对以后编程进步有用哟！
学习SQL，请参观：http://club.excelhome.net/thread-859194-1-1.html

汇总方式1：

单个工作簿内全部工作表汇总，要求SQL所含标题名在每一个要统计的工作表中都有
完整的代码和自定义函数见附件： 全部工作表汇总到一个工作表.rar (25.45 KB, 下载次数: 3079)

2014-12-3 21:55 上传

点击文件名下载附件

1. 
   
2. 
   
3. '*********************************
   
4. '*******  北极狐工作室出品  ******
   
5. '*******  QQ：14885553      ******
   
6. '*********************************
   
7. 
   
8. Sub Opiona()
   
9. 'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
   
10. Application.ScreenUpdating = False '//关闭屏幕刷新
    
11. Application.DisplayAlerts = False '//关闭系统提示
    
12. t = Timer   '//开始时间
    
13. 
    
14.     Set SH0 = Sheets("汇总")
    
15.     SH0.Cells.Clear  '//清空保存区域，全部数据第一行是标题行，且只占一行，无合并单元格
    
16.     Str_coon = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullName   '//Excel2007
    
17. '   Str_coon = "Provider=Microsoft.JET.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=yes';data source=" & ThisWorkbook.FullName    '//OFFICE2003，根据情况选择
    
18. 
    
19.     For Each SH In ThisWorkbook.Worksheets
    
20.         If SH.Name <> SH0.Name Then
    
21.             StrSQL = "SELECT 居间人,应发佣金,营业税,城建税,教育附加,'" & SH.Name & "' AS 来自工作表 FROM [" & SH.Name & "$]"   '//SQL语句自己发挥吧，这里是精髓。
    
22.             IROW = SH0.Range("A1048576").End(3).Row + 1
    
23.             If IROW <= 2 Then
    
24.                 IROW = 1
    
25.                 Crr = GET_SQLCoon(StrSQL, Str_coon, True)  '//第一次，带上标题
    
26.             Else
    
27.                 Crr = GET_SQLCoon(StrSQL, Str_coon, False)
    
28.             End If
    
29.             SH0.Range("A" & IROW).Resize(UBound(Crr, 1) + 1, UBound(Crr, 2) + 1) = Crr  '//粘贴查询结果
    
30.         End If
    
31.    
    
32.     Next SH
    
33. Application.ScreenUpdating = True '//恢复屏幕刷新
    
34. Application.DisplayAlerts = True '//恢复系统提示
    
35. MsgBox "汇总用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
    
36. End Sub
    

复制代码

补充内容 (2018-4-9 22:06):
通用一些的：汇总，然后：拆分   
可增减表格数，详见：79楼！

补充内容 (2018-4-18 15:51):

汇总多个文件指定表中多个固定位置数据-通用型，80楼问题，答案见80,81  

张雄友

没多大作用。sheet2中的个人所得税都没有汇总到。

opiona

汇总方式2：

很多工作簿在文件夹和子文件夹内，汇总全部工作簿内的同名工作表
完整的代码在附件中： 跨工作簿汇总同名工作表.rar (70.73 KB, 下载次数: 2209)

2014-12-3 22:09 上传

点击文件名下载附件

1. 
   
2. '*********************************
   
3. '******* 北极狐工作室出品 ******
   
4. '******* QQ：14885553 ******
   
5. '*********************************
   
6. 
   
7. Sub Opiona()
   
8. 'On Error Resume Next '// 发生错误，自动执行下一句，就是忽略错误
   
9. Application.ScreenUpdating = False '//关闭屏幕刷新
   
10. Application.DisplayAlerts = False '//关闭系统提示
    
11. t = Timer '//开始时间
    
12. Set SH0 = Sheets("汇总")
    
13. SH0.Cells.Clear '//清空保存区域，全部数据第一行是标题行，且只占一行，无合并单元格
    
14. ARR = FileAllArr(ThisWorkbook.Path, "*.xlsx", ThisWorkbook.Name, False) '//详见函数说明
    
15. SHName = "数据表" '//要求所有工作簿内需要统计的工作表名称相同，
    
16. For I = 0 To UBound(ARR)
    
17. Str_coon = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';data source=" & ARR(I) '//Excel2007
    
18. ' Str_coon = "Provider=Microsoft.JET.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=yes';data source=" & & ARR(I) '//OFFICE2003，根据情况选择
    
19. StrSQL = "SELECT 居间人,应发佣金,营业税,城建税,教育附加,'" & GetPathFromFileName(ARR(I), False) & "' AS 来自工作簿 FROM [" & SHName & "$]" '//SQL语句自己发挥吧，这里是精髓。
    
20. IROW = SH0.Range("A1048576").End(3).Row + 1
    
21. If IROW <= 2 Then
    
22. IROW = 1
    
23. Crr = GET_SQLCoon(StrSQL, Str_coon, True) '//第一次，带上标题
    
24. Else
    
25. Crr = GET_SQLCoon(StrSQL, Str_coon, False)
    
26. End If
    
27. SH0.Range("A" & IROW).Resize(UBound(Crr, 1) + 1, UBound(Crr, 2) + 1) = Crr '//粘贴查询结果
    
28. Next
    
29. 
    
30. Application.ScreenUpdating = True '//恢复屏幕刷新
    
31. Application.DisplayAlerts = True '//恢复系统提示
    
32. MsgBox "汇总用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!" '//提示所用时间
    
33. End Sub
    
34. 
    
35. Rem 下面是为方便整理的自定义函数，上面的代码执行必不可少哟！！
    

复制代码

opiona

张雄友 发表于 2014-12-3 22:03
没多大作用。sheet2中的个人所得税都没有汇总到。

每个表都要加上：个人所得税  否则会提示出错！
SQL语句修改成下面这样既可

1. StrSQL = "SELECT 居间人,应发佣金,营业税,城建税,教育附加,个人所得税,'" & SH.Name & "' AS 来自工作表 FROM [" & SH.Name & "$]"  
   

复制代码

张雄友

opiona 发表于 2014-12-3 22:14
每个表都要加上：个人所得税  否则会提示出错！
SQL语句修改成下面这样既可

这个查询怎么办？

opiona

汇总方式3：

多个工作簿在文件夹和子文件夹内，
各个工作簿含有数量的工作表
汇总指定工作表，相同名称的工作表标题相同
完整代码和自定义函数见附件： 跨工作簿汇总多个工作表.rar (90.27 KB, 下载次数: 1644)

2014-12-3 22:46 上传

点击文件名下载附件

1. 
   
2. '*********************************
   
3. '*******  北极狐工作室出品  ******
   
4. '*******  QQ：14885553      ******
   
5. '*********************************
   
6. 
   
7. Sub Opiona()
   
8. 'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
   
9. Application.ScreenUpdating = False '//关闭屏幕刷新
   
10. Application.DisplayAlerts = False '//关闭系统提示
    
11. t = Timer   '//开始时间
    
12. 
    
13.    
    
14.     Set SH0 = Worksheets("首页")
    
15.    
    
16.     For Each SH In ThisWorkbook.Sheets
    
17.          If SH.Name <> SH0.Name Then
    
18.                SH.Delete
    
19.          End If
    
20.     Next SH
    
21.    
    
22.     ARR = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, False)
    
23.     For k = 2 To SH0.Range("A1048576").End(3).Row
    
24.         If SH0.Cells(k, 1) <> "" Then
    
25.             ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = SH0.Cells(k, 1) '//添加此工作表
    
26.             Set SH = ThisWorkbook.Worksheets(SH0.Cells(k, 1).Value)
    
27. 
    
28.             For I = 0 To UBound(ARR)
    
29.                 Str_coon = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';data source=" & ARR(I)   '//Excel2007
    
30.             '   Str_coon = "Provider=Microsoft.JET.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=yes';data source=" & & ARR(I)     '//OFFICE2003，根据情况选择
    
31.                
    
32.                 StrSQL = "SELECT *,'" & GetPathFromFileName(ARR(I)) & "' AS 来自工作簿 FROM [" & SH.Name & "$]"
    
33.                 IROW = SH.Range("a65536").End(3).Row + 1
    
34.                 If IROW <= 2 Then
    
35.                     IROW = 1
    
36.                     CRR = GET_SQLCoon(StrSQL, Str_coon, True)
    
37.                 Else
    
38.                     CRR = GET_SQLCoon(StrSQL, Str_coon, False)
    
39.                 End If
    
40.                 SH.Range("A" & IROW).Resize(UBound(CRR, 1) + 1, UBound(CRR, 2) + 1) = CRR
    
41.             Next I
    
42.    
    
43.         End If
    
44.     Next k
    
45. 
    
46. Application.ScreenUpdating = True '//恢复屏幕刷新
    
47. Application.DisplayAlerts = True '//恢复系统提示
    
48. MsgBox "汇总用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
    
49. End Sub

复制代码

opiona

张雄友 发表于 2014-12-3 22:31
这个查询怎么办？

提示太复杂，可能是SQL语句超出3000字符，建议加一个中间表。
再有就是SQL连接有点问题
建议改成：

1. 
   
2.             If sh.Name <> ActiveSheet.Name Then
   
3.                 If .CountA(sh.UsedRange) Then
   
4.                     If SQL = "" Then
   
5.                         SQL = "select * from [" & sh.Name & "$A2:D65536]"
   
6.                     Else
   
7.                         SQL = SQL & " union all select * from [" & sh.Name & "$A2:D65536]"
   
8.                     End If
   
9.                 End If
   
10.             End If

复制代码

opiona

原来弄错了：
提示太复杂，可能是SQL语句超出3000字符，
减少表到20以内，可以直接出结果
建议加一个中间表，弄到一个表之后再分类汇总。

opiona

张雄友 发表于 2014-12-3 22:31
这个查询怎么办？

SQL语句有限制，工作表太多要找个地方存中间数据
然后再求和等分类汇总，见附件模块2： 这个查询.rar (68.66 KB, 下载次数: 807)

2014-12-3 23:31 上传

点击文件名下载附件

1. Sub Opiona()
   
2. 'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
   
3. Application.ScreenUpdating = False '//关闭屏幕刷新
   
4. Application.DisplayAlerts = False '//关闭系统提示
   
5. t = Timer   '//开始时间
   
6. 
   
7.     Set sh0 = Sheets("汇总")
   
8.     sh0.Range("A3:E1048500").ClearContents '//清空保存区域，全部数据第一行是标题行，且只占一行，无合并单元格
   
9.     sh0.Range("i3:m1048500").ClearContents
   
10.     Str_coon = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullName   '//Excel2007
    
11. '   Str_coon = "Provider=Microsoft.JET.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=yes';data source=" & ThisWorkbook.FullName    '//OFFICE2003，根据情况选择
    
12. 
    
13.     For Each sh In ThisWorkbook.Worksheets
    
14.         If sh.Name <> sh0.Name Then
    
15.             StrSQL = "SELECT * FROM [" & sh.Name & "$A2:D]"   '//SQL语句自己发挥吧，这里是精髓。
    
16.             IROW = sh0.Range("A1048576").End(3).Row + 1
    
17.             Crr = GET_SQLCoon(StrSQL, Str_coon, False)
    
18.             sh0.Range("A" & IROW).Resize(UBound(Crr, 1) + 1, UBound(Crr, 2) + 1) = Crr  '//粘贴查询结果
    
19.         End If
    
20. 
    
21.     Next sh
    
22.    
    
23.     StrSQL = "select 名称,sum(数量) AS 数量合计,sum(金额) AS 金额合计,max(单价) AS 最大单价,min(单价) AS 最小单价 from [" & sh0.Name & "$a2:d] group by 名称"
    
24.     Crr = GET_SQLCoon(StrSQL, Str_coon, False)
    
25.     sh0.Range("I3").Resize(UBound(Crr, 1) + 1, UBound(Crr, 2) + 1) = Crr  '//粘贴查询结果
    
26.     sh0.Select
    
27. Application.ScreenUpdating = True '//恢复屏幕刷新
    
28. Application.DisplayAlerts = True '//恢复系统提示
    
29. MsgBox "汇总用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
    
30. End Sub

复制代码

百度不到去谷歌

sql语句做通用的怕是总是容易出错  如果是对sql很了解的用是可以的
单列稀疏数据 单列文本数字混合 合并单元格表头 这些情况sql都极易出错
个人觉得还是用数组或者字典保险一点
当然更重要的是源数据要规范 混乱格式的源数据 什么方法也汇总出来