多个子表汇总成一个表

lsc900707

443908632 发表于 2016-7-17 19:11
朱老师谢谢你 我试了一下汇总有错误 你看看 出的也不行

亲，你的进表和出表结构都不一样，怎么能完全套用进表的代码呢？晕！

443908632

朱荣兴 发表于 2016-7-17 21:55
什么错误，请具体说清楚，另外，你需要如何汇总，也请具体说明

还是要麻烦您 我已经修改好在文件里面

443908632

lsc900707 发表于 2016-7-17 19:23
亲，你的进表和出表结构都不一样，怎么能完全套用进表的代码呢？晕！

那您帮我改改吗 我已经上传了要求 在文件里面

opiona

1. Sub Opiona()
   
2. 
   
3. 'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
   
4. Application.ScreenUpdating = False '//关闭屏幕刷新
   
5. Application.DisplayAlerts = False '//关闭系统提示
   
6. t = Timer   '//开始时间
   
7. 
   
8. 
   
9.    
   
10.     Str_coon = "HDR=NO;IMEX=1';Data Source =" & ThisWorkbook.FullName     '//OFFICE2003，2007 通用
    
11.     Str进出 = "出"
    
12.     Set SH0 = Sheets("总表" & Str进出)
    
13.     SH0.Range("A4:S65536").ClearContents
    
14.     For I = 1 To 12
    
15. 
    
16.         StrSQL = "SELECT  F1 AS 日期,F2 AS 码单号,F3 AS 品名,F4 AS 数量,F5 AS 合计"
    
17.         StrSQL = StrSQL & ",F6 AS 杉木原木,F7 AS 杉木小径,F8 AS 杉木等外"
    
18.         StrSQL = StrSQL & ",F9 AS 松木原木,F10 AS 松木小径,F11 AS 松木等外"
    
19.         StrSQL = StrSQL & ",F12 AS 杂木原木,F13 AS 杂木小径,F14 AS 杂木等外"
    
20.         StrSQL = StrSQL & ",F15 AS 薪材松木,F16 AS 薪材杂木,F17 AS 锯材松锯材,F18 AS 锯材杂锯材"
    
21.         StrSQL = StrSQL & "," & Format(I, "00") & " AS 月份"
    
22.         StrSQL = StrSQL & " FROM [" & Str进出 & Format(I, "00") & "月$A6:R] WHERE 1=1"
    
23.         StrSQL = StrSQL & " AND INSTR(F1,'合计')=0"
    
24.         StrSQL = StrSQL & " AND INSTR(F1,'累计')=0"
    
25. '        StrSQL = StrSQL & " AND INSTR(F1,'库存')=0"
    
26.         StrSQL = StrSQL & " AND F4>0"
    
27. 
    
28.         IROW = SH0.Range("A65536").End(3).Row + 1
    
29.         If IROW < 4 Then IROW = 4
    
30.         SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
    
31.         SH0.Range("A" & IROW).Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR '//（0 TO X)的数组行列都要+1，(1 TO X) 的不要
    
32.     Next I
    
33. 
    
34.     Str进出 = "进"
    
35.     Set SH0 = Sheets("总表" & Str进出)
    
36.     SH0.Range("A4:S65536").ClearContents
    
37.     For I = 1 To 12
    
38.         
    
39.         StrSQL = "SELECT F1 AS 日期"
    
40.         StrSQL = StrSQL & ",F17 AS 码单号"
    
41.         StrSQL = StrSQL & ",F2 AS 合计"
    
42.         StrSQL = StrSQL & ",F3 AS 杉木原木"
    
43.         StrSQL = StrSQL & ",F4 AS 杉木小径"
    
44.         StrSQL = StrSQL & ",F5 AS 杉木等外"
    
45.         StrSQL = StrSQL & ",F6 AS 松木原木"
    
46.         StrSQL = StrSQL & ",F7 AS 松木小径"
    
47.         StrSQL = StrSQL & ",F8 AS 松木等外"
    
48.         StrSQL = StrSQL & ",F9 AS 杂木原木"
    
49.         StrSQL = StrSQL & ",F10 AS 杂木小径"
    
50.         StrSQL = StrSQL & ",F11 AS 杂木等外"
    
51.         StrSQL = StrSQL & ",F12 AS 薪材松木"
    
52.         StrSQL = StrSQL & ",F13 AS 薪材杂木"
    
53.         StrSQL = StrSQL & ",F14 AS 锯材松锯材"
    
54.         StrSQL = StrSQL & ",F15 AS 锯材杂锯材"
    
55.         StrSQL = StrSQL & "," & Format(I, "00") & " AS 月份"
    
56.         StrSQL = StrSQL & " FROM [" & Str进出 & Format(I, "00") & "月$A6:Q] WHERE 1=1"
    
57.         StrSQL = StrSQL & " AND INSTR(F1,'合计')=0"
    
58.         StrSQL = StrSQL & " AND INSTR(F1,'累计')=0"
    
59. '        StrSQL = StrSQL & " AND INSTR(F1,'库存')=0"
    
60. 
    
61.         IROW = SH0.Range("A65536").End(3).Row + 1
    
62.         If IROW < 4 Then IROW = 4
    
63.         SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
    
64.         SH0.Range("A" & IROW).Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR '//（0 TO X)的数组行列都要+1，(1 TO X) 的不要
    
65.     Next I
    
66.    
    
67. Application.ScreenUpdating = True '//恢复屏幕刷新
    
68. Application.DisplayAlerts = True '//恢复系统提示
    
69. MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
    
70. End Sub

复制代码

opiona

好像不止一次提出此问题
2016.rar (71.25 KB, 下载次数: 37)

2016-7-17 23:14 上传

点击文件名下载附件

lsc900707

opiona 发表于 2016-7-17 23:14
好像不止一次提出此问题

亲，你的数据文件不是最新的，用最新的数据测试结果是这样。你的sql+自定义函数屡试不爽呀。

LMY123

ADO,同薄多表汇总

jjmysjg

朱荣兴 发表于 2016-7-17 23:04
汇总表内出现标题，是因为你的几个分表内没有数据，你把数据填完整，就可以啦，这不是代码的问题，

怎么屏蔽0值，麻烦版主修改一下
谢谢