[已解决]请老师修改代码

hlb117

照瓢画芦葫，写了个代码，运行时出现错误：详见附件    20140306.zip (236.61 KB, 下载次数: 10)

2014-3-8 10:52 上传

点击文件名下载附件 请老师修改代码

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-3-8 11:19

1. Sub 统计汇总()
   
2.     Dim conn, sql(1 To 2), address(1 To 2), i, arr(1 To 2)
   
3.     Set conn = CreateObject("adodb.connection")
   
4.     If Val(Application.Version) >= 12 Then
   
5.         conn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
   
6.     Else
   
7.         conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
   
8.     End If
   
9.     sql(1) = "select 商品编码,商品名称,发生单价,sum(销售数量),sum(实收金额) from [销售汇总$a3:j] where 所属组织 is not null group by 商品编码,商品名称,发生单价"
   
10.     sql(2) = "select 销售日期,sum(销售数量),sum(实收金额) from [销售汇总$a3:j]  where 所属组织 is not null group by  销售日期"
    
11. 
    
12.     'sql(1) = "select 商品编码,商品名称,发生单价,sum(销售数量),sum(实收金额),from [销售汇总$a4:j] where 所属组织 is not null group by 商品编码,商品名称,发生单价"
    
13.     'sql(2) = "select 销售日期,sum(销售数量),sum(实收金额),from [销售汇总$a4:j]  where 所属组织 is not null group by  销售日期"
    
14. 
    
15.     address(1) = "B"
    
16.     address(2) = "J"
    
17.     With Sheets("统计汇总")
    
18.         .Range("b4:z" & Application.Max(.[b65536].End(xlUp).Row, 4)).Clear
    
19.         For i = 1 To 2
    
20.             .Range(address(i) & 4).CopyFromRecordset conn.Execute(sql(i))
    
21.         Next i
    
22.         For i = 1 To 2
    
23.             arr(i) = .Range(address(i) & 65536).End(xlUp).Row
    
24.             .Range(address(i) & arr(i) + 1) = "合计"
    
25.         Next i
    
26.         .Range("e" & arr(1) + 1).FormulaR1C1 = "=sum(r2c:r[-1]c)"
    
27.         .Range("f" & arr(1) + 1).FormulaR1C1 = "=sum(r2c:r[-1]c)"
    
28.         .Range("k" & arr(2) + 1).FormulaR1C1 = "=sum(r2c:r[-1]c)"
    
29.         .Range("l" & arr(2) + 1).FormulaR1C1 = "=sum(r2c:r[-1]c)"
    
30. 
    
31.         With Application.Union(.[e:e], .[f:f], .[k:k], .[l:l])
    
32.             .NumberFormat = "0.00"
    
33.         End With
    
34.         For i = 1 To 2
    
35.             With Range(address(i) & 4).CurrentRegion
    
36.                 .Font.Size = 10
    
37.                 .Borders.LineStyle = xlContinuous
    
38.                 .HorizontalAlignment = xlCenter
    
39.             End With
    
40.         Next i
    
41.     End With
    
42.     conn.Close: Set sonn = Nothing
    
43. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Sub 统计汇总()
   
2.     Dim conn, sql(1 To 2), address(1 To 2), i, arr(1 To 2)
   
3.     Set conn = CreateObject("adodb.connection")
   
4.     If Val(Application.Version) >= 12 Then
   
5.         conn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
   
6.     Else
   
7.         conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
   
8.     End If
   
9.     sql(1) = "select 商品编码,商品名称,发生单价,sum(销售数量),sum(实收金额) from [销售汇总$a3:j] where 所属组织 is not null group by 商品编码,商品名称,发生单价"
   
10.     sql(2) = "select 销售日期,sum(销售数量),sum(实收金额) from [销售汇总$a3:j]  where 所属组织 is not null group by  销售日期"
    
11. 
    
12.     'sql(1) = "select 商品编码,商品名称,发生单价,sum(销售数量),sum(实收金额),from [销售汇总$a4:j] where 所属组织 is not null group by 商品编码,商品名称,发生单价"
    
13.     'sql(2) = "select 销售日期,sum(销售数量),sum(实收金额),from [销售汇总$a4:j]  where 所属组织 is not null group by  销售日期"
    
14. 
    
15.     address(1) = "B"
    
16.     address(2) = "J"
    
17.     With Sheets("统计汇总")
    
18.         .Range("b4:z" & Application.Max(.[b65536].End(xlUp).Row, 4)).Clear
    
19.         For i = 1 To 2
    
20.             .Range(address(i) & 4).CopyFromRecordset conn.Execute(sql(i))
    
21.         Next i
    
22.         For i = 1 To 2
    
23.             arr(i) = .Range(address(i) & 65536).End(xlUp).Row
    
24.             .Range(address(i) & arr(i) + 1) = "合计"
    
25.         Next i
    
26.         .Range("e" & arr(1) + 1).FormulaR1C1 = "=sum(r2c:r[-1]c)"
    
27.         .Range("f" & arr(1) + 1).FormulaR1C1 = "=sum(r2c:r[-1]c)"
    
28.         .Range("k" & arr(2) + 1).FormulaR1C1 = "=sum(r2c:r[-1]c)"
    
29.         .Range("l" & arr(2) + 1).FormulaR1C1 = "=sum(r2c:r[-1]c)"
    
30. 
    
31.         With Application.Union(.[e:e], .[f:f], .[k:k], .[l:l])
    
32.             .NumberFormat = "0.00"
    
33.         End With
    
34.         For i = 1 To 2
    
35.             With Range(address(i) & 4).CurrentRegion
    
36.                 .Font.Size = 10
    
37.                 .Borders.LineStyle = xlContinuous
    
38.                 .HorizontalAlignment = xlCenter
    
39.             End With
    
40.         Next i
    
41.     End With
    
42.     conn.Close: Set sonn = Nothing
    
43. End Sub
    

复制代码

hwc2ycy

SQL语句中在FROM前面多加了个逗号。

另外标题行是在A3。表的区域应该是从A3开始。

hwc2ycy

1. sql(1) = "select 商品编码,商品名称,发生单价,sum(销售数量),sum(实收金额) from [销售汇总$a3:j] where 所属组织 is not null group by 商品编码,商品名称,发生单价"
   
2. sql(2) = "select 销售日期,sum(销售数量),sum(实收金额) from [销售汇总$a3:j]  where 所属组织 is not null group by  销售日期"
   

复制代码

問天

学习，帮顶

hlb117

hwc2ycy 发表于 2014-3-8 11:20

谢谢！老师请再帮忙看看筛选不同数值的问题， 20140308.zip (249.47 KB, 下载次数: 3)

2014-3-9 03:26 上传

点击文件名下载附件

hwc2ycy

hlb117 发表于 2014-3-9 03:26
谢谢！老师请再帮忙看看筛选不同数值的问题，

这个等有时间帮再你弄吧。