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

yepulu

进来学习了。

送人亲

学习了，谢谢！

送人亲

opiona 发表于 2014-12-3 23:31
SQL语句有限制，工作表太多要找个地方存中间数据
然后再求和等分类汇总，见附件模块2：

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

送人亲

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个工作表。我按照老师提供的代码，进行了改写，但是提示下标越界，标红的部分。代码如上，还请老师指点一二。附件也会上传，谢谢了。

送人亲

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

opiona

你这种情况，最好先汇总到一个临时表中（复制）
然后用临时表再：分类汇总

附件中代码可以用，但是如果

1. Sub Opiona()
   
2. 
   
3. 'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
   
4. Application.ScreenUpdating = False '//关闭屏幕刷新
   
5. Application.DisplayAlerts = False '//关闭系统提示
   
6. t = Timer   '//开始时间
   
7. 
   
8.     Set SH0 = Sheets("汇总")
   
9.     SH0.Range("A2:H65536").ClearContents
   
10.    
    
11.     FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
    
12.     Str_coon = "HDR=yes';Data Source =" & ThisWorkbook.FullName    '//OFFICE2003，2007 通用
    
13.     For I = 0 To UBound(FileArr)
    
14.             Str_xxxx = "HDR=yes';Data Source =" & FileArr(I)     '//OFFICE2003，2007 通用
    
15.             NameArr = GET_NameSheets(Str_xxxx)
    
16.             For n = 0 To UBound(NameArr)   '//循环所有工作表
    
17.             
    
18.                 If StrSQL <> "" Then StrSQL = StrSQL & " union all "  '//这里前后有空格
    
19.                 StrSQL = StrSQL & "select 站点,单量 from [Excel 12.0;HDR=YES;Database=" & FileArr(I) & "].[" & NameArr(n) & "$]"
    
20.             
    
21.           Next n
    
22.     Next I
    
23.    
    
24. StrSQL1 = "SELECT 站点,SUM(单量) as 单量 FROM (" & StrSQL & ") GROUP BY 站点 ORDER BY 站点"
    
25. SQLARR = GET_SQL_To_Arr(StrSQL1, Str_coon, False)
    
26. 
    
27. 'MsgBox StrSQL1
    
28. SH0.Range("A2").Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR
    
29. Application.ScreenUpdating = True '//恢复屏幕刷新
    
30. Application.DisplayAlerts = True '//恢复系统提示
    
31. MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
    
32. End Sub

复制代码

文件或工作表多了，就可能出错！

opiona

下面是标准一点的
不限文件数量，不限工作表个数

1. Sub 标准汇总方式()
   
2. 
   
3. 'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
   
4. Application.ScreenUpdating = False '//关闭屏幕刷新
   
5. Application.DisplayAlerts = False '//关闭系统提示
   
6. t = Timer   '//开始时间
   
7.   
   
8.     Set SHX = Sheets("TEMPXX")
   
9.     SHX.Range("A2:D1048576").ClearContents
   
10.    
    
11.     FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
    
12.     For I = 0 To UBound(FileArr)
    
13.    
    
14.         Str_coon = "HDR=yes';Data Source =" & FileArr(I)    '//OFFICE2003，2007 通用
    
15.         NameArr = GET_NameSheets(Str_coon)
    
16.         For N = 0 To UBound(NameArr)
    
17.             StrSQL = "SELECT 站点,单量"
    
18.             StrSQL = StrSQL & ",'" & NameArr(N) & "' AS  工作表"
    
19.             StrSQL = StrSQL & ",'" & GetPathFromFileName(FileArr(I)) & "' AS  工作簿"
    
20.             StrSQL = StrSQL & " FROM [" & NameArr(N) & "$]"
    
21.             IROW = SHX.Range("A1048576").End(3).Row + 1
    
22.             SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
    
23.             SHX.Range("A" & IROW).Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR '//（0 TO X)的数组行列都要+1，(1 TO X) 的不要
    
24.         Next N
    
25.    
    
26.     Next I
    
27. 
    
28.     Set SH0 = Sheets("汇总")
    
29.     SH0.Range("A2:B1048576").ClearContents
    
30.    
    
31.     StrSQL = "SELECT 站点,SUM(单量) as 单量 FROM [" & SHX.Name & "$] GROUP BY 站点 ORDER BY 站点"
    
32.     Str_coon = "HDR=yes';Data Source=" & ThisWorkbook.FullName
    
33.     SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
    
34.    
    
35.     'MsgBox StrSQL
    
36.     SH0.Range("A2").Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR
    
37. 
    
38. Application.ScreenUpdating = True '//恢复屏幕刷新
    
39. Application.DisplayAlerts = True '//恢复系统提示
    
40. MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
    
41. End Sub

复制代码

opiona

标准实验.rar (57.88 KB, 下载次数: 337)

2016-9-25 21:11 上传

点击文件名下载附件

送人亲

opiona 发表于 2016-9-25 21:11

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

opiona

送人亲 发表于 2016-9-25 23:16
老师，你好，附件已经测试，可以使用，非常感谢！
还有您提到，如果文件或工作表多的话会出错，那么您提 ...

对的，是这样子！