求助求助，有关多行合并求和

zhaogang1960

yqdaqinqin 发表于 2013-1-14 15:18
有个问题想请您分析一下，vba可以处理吗？非常感谢

请测试:

1. Sub bbb()
   
2.     Dim cnn As Object
   
3.     Dim SQL$
   
4.     Set cnn = CreateObject("adodb.connection")
   
5.     cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
   
6.     SQL = "select first(代码) as 代码,科目,sum(期初余额) as 期初余额,sum(本期借方) as 本期借方,sum(本期贷方) as 本期贷方,sum(累计借方) as 累计借方,sum(累计贷方) as 累计贷方,sum(期末余额) as 期末余额 from [sheet1$] group by 科目 order by first(代码) desc"
   
7.     SQL = "select 代码,科目,iif(期初余额<>0,'贷','平'),期初余额,本期借方,本期贷方,累计借方,累计贷方,iif(期末余额<>0,'贷','平'),期末余额 from (" & SQL & ")"
   
8.     With Sheets("sheet2")
   
9.         .UsedRange.Offset(1).ClearContents
   
10.         .[a2].CopyFromRecordset cnn.Execute(SQL)
    
11.         .Activate
    
12.     End With
    
13.     cnn.Close
    
14.     Set cnn = Nothing
    
15. End Sub
    

复制代码

zhaogang1960

使用first(代码)是认为代码不参与分组，即仅对科目分组
请看附件
liz2007.rar (20.35 KB, 下载次数: 32)

2013-1-14 15:54 上传

点击文件名下载附件

yqdaqinqin

zhaogang1960 发表于 2013-1-14 15:54
使用first(代码)是认为代码不参与分组，即仅对科目分组
请看附件

运行了一下命令，没反应！

yqdaqinqin

我更改了一下表格，麻烦你看看VBA不认可“2202”！

yqdaqinqin

yqdaqinqin 发表于 2013-1-14 16:39
我更改了一下表格，麻烦你看看VBA不认可“2202”！

赵老师：我的excel2003不是正版，是不是不可以运行sql程序呢？

zhaogang1960

yqdaqinqin 发表于 2013-1-14 16:45
赵老师：我的excel2003不是正版，是不是不可以运行sql程序呢？

我看你的代码是2007的，就按照2007给你写的，改为2003：

1. Sub bbb()
   
2.     Dim cnn As Object
   
3.     Dim SQL$
   
4.     Set cnn = CreateObject("adodb.connection")
   
5.     cnn.Open "provider=microsoft.Jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
   
6.     SQL = "select first(代码) as 代码,科目,sum(期初余额) as 期初余额,sum(本期借方) as 本期借方,sum(本期贷方) as 本期贷方,sum(累计借方) as 累计借方,sum(累计贷方) as 累计贷方,sum(期末余额) as 期末余额 from [sheet1$] group by 科目 order by first(代码) desc"
   
7.     SQL = "select 代码,科目,iif(期初余额<>0,'贷','平'),期初余额,本期借方,本期贷方,累计借方,累计贷方,iif(期末余额<>0,'贷','平'),期末余额 from (" & SQL & ")"
   
8.     With Sheets("sheet2")
   
9.         .UsedRange.Offset(1).ClearContents
   
10.         .[a2].CopyFromRecordset cnn.Execute(SQL)
    
11.         .Activate
    
12.     End With
    
13.     cnn.Close
    
14.     Set cnn = Nothing
    
15. End Sub
    

复制代码

zhaogang1960

请看新附件
liz1.rar (9.37 KB, 下载次数: 29)

2013-1-14 16:51 上传

点击文件名下载附件

yqdaqinqin

zhaogang1960 发表于 2013-1-14 16:48
我看你的代码是2007的，就按照2007给你写的，改为2003：

呵呵，我改了一下问题，之后把代码也变了一下，VBA不认账变红了，你帮忙看看那个问题如何处理

zhaogang1960

yqdaqinqin 发表于 2013-1-14 16:54
呵呵，我改了一下问题，之后把代码也变了一下，VBA不认账变红了，你帮忙看看那个问题如何处理

1. Sub bbb()
   
2.     Dim cnn As Object
   
3.     Dim SQL$
   
4.     Set cnn = CreateObject("adodb.connection")
   
5.     cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
   
6.     SQL = "select first(代码) as 代码,科目,sum(期初余额) as 期初余额,sum(本期借方) as 本期借方,sum(本期贷方) as 本期贷方,sum(累计借方) as 累计借方,sum(累计贷方) as 累计贷方,sum(期末余额) as 期末余额 from [sheet1$] group by 科目 order by first(代码) desc"
   
7.     SQL = "select 代码,科目,iif(left(代码,4) ='2202',iif(期初余额<>0,'贷','平'),'借贷1'),期初余额,本期借方,本期贷方,累计借方,累计贷方,iif(left(代码,4) ='2202',iif(期末余额<>0,'贷','平'),'借贷2'),期末余额 from (" & SQL & ")"
   
8.     With Sheets("sheet2")
   
9.         .UsedRange.Offset(1).ClearContents
   
10.         .[a2].CopyFromRecordset cnn.Execute(SQL)
    
11.         .Activate
    
12.     End With
    
13.     cnn.Close
    
14.     Set cnn = Nothing
    
15. End Sub
    

复制代码

zhaogang1960

错误太多了，连2202都写成了2002，对应你写的代码好好比较一下：
liz1ii.rar (9.6 KB, 下载次数: 37)

2013-1-14 17:09 上传

点击文件名下载附件