VBA求和

新手报到来了

老师帮忙看看编码怎么写

mineshine

仅供参考

1. 
   
2. Sub test()
   
3. Dim conn As Object, sql$, Sh As Worksheet, i As Integer, r As Long
   
4. Set Sh = Sheets("Sheet2")
   
5. Set conn = CreateObject("adodb.connection")
   
6.     If Val(Application.Version) < 12 Then
   
7.         'You use Excel 2000-2003
   
8.         FileExtStr = ".xls": FileFormatNum = -4143
   
9.         conn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=yes;';Data Source=" & ThisWorkbook.FullName
   
10.     Else
    
11.         'You use Excel 2007-2010
    
12.         FileExtStr = ".xlsx": FileFormatNum = 51
    
13.         conn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=yes';data source=" & ThisWorkbook.FullName
    
14.     End If
    
15. sql = "Select A1,A2,A3,A4,sum(期初),sum(入库), sum(出库),SUM(期初)+SUM(入库)+SUM(出库) AS 库存 from (" & _
    
16.       "select 物品代码 as A1,物品名称 AS A2,规格型号 AS A3,单位 AS A4,0 as 期初,sum(数量) as 入库,0 as 出库 from [Sheet1$] where 票据类型='入库' group by 物品代码,物品名称,规格型号,单位 " & _
    
17.       "UNION ALL " & _
    
18.       "select 物品代码 AS A1,物品名称 AS A2,规格型号 AS A3,单位 AS A4,0 as 期初,0 as 入库,sum(数量) as 出库 from [Sheet1$] where 票据类型='出库' group by 物品代码,物品名称,规格型号,单位 " & _
    
19.       ") group by A1,A2,A3,A4 order by A1,A2,A3"
    
20. Sh.Range("A2").CopyFromRecordset conn.Execute(sql)
    
21. conn.Close
    
22. Set conn = Nothing
    
23. r = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row    'A栏最后非空白列
    
24. Sh.Cells(r + 1, 1) = "合计"
    
25. For i = 5 To 8
    
26.     Sh.Cells(r + 1, i) = Application.WorksheetFunction.Sum(Sh.Range(Sh.Cells(2, i), Sh.Cells(r, i)))    '加总合计
    
27. Next i
    
28. MsgBox "OK"
    
29. End Sub
    

复制代码