怎样计算出工程毛利

zh2783458

请教老师：利用VBA，怎样才能计算出毛利试算表中的工程毛利？谢谢！

zh2783458

朱荣兴 发表于 2018-8-20 11:29
需要对那一列数据求和？？？？？？？？？？？？？

谢谢版主：以二级科目名称为主，毛利试算表中数据需要从工程明细表中查找并计算到毛利试算表。

zh2783458

朱荣兴 发表于 2018-8-20 11:55
处理了小计的问题》》》》》》》》》》》》》
Sub 毛利计算()
Set d = CreateObject("scripting.dictiona ...

朱老师：总计也已经解决了，谢谢您！

iwangyi

Sub ADO_SQL_PIVOT()
Application.DisplayAlerts = False
Set cn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= " & ThisWorkbook.FullName
sql = "SELECT * FROM [工程明细$] WHERE 一级科目='预收账款'"
Set rs.ActiveConnection = cn
rs.Open sql
Set pvc = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
Set pvc.Recordset = rs
Set pvt = ActiveSheet.PivotTables.Add(PivotCache:=pvc, TableDestination:=Range("b4"))
With pvt
.SmallGrid = False
.AddFields RowFields:="二级科目", ColumnFields:="三级科目"
.AddDataField .PivotFields("贷方金额"), "贷方金额求和", xlSum
End With
Set cn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= " & ThisWorkbook.FullName
sql = "SELECT * FROM [工程明细$] WHERE 一级科目='工程施工'"
Set rs.ActiveConnection = cn
rs.Open sql
Set pvc = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
Set pvc.Recordset = rs
Set pvt = ActiveSheet.PivotTables.Add(PivotCache:=pvc, TableDestination:=Range("g4"))
With pvt
.SmallGrid = False
.AddFields RowFields:="二级科目", ColumnFields:="三级科目"
.AddDataField .PivotFields("借方金额"), "借方金额求和", xlSum
End With
Cells.Copy
[A1].PasteSpecial Paste:=xlPasteValues
N = [b65536].End(3).Row
Range("b6:b" & N).Copy [b4]: Range("c5:f" & N).Copy [c3]
Range("h5:n" & N).Copy [g3]
Rows(N - 1).EntireRow.Delete
Rows(N - 1).EntireRow.Delete
For k = 4 To N - 2
Cells(k, "n") = Cells(k, "f") - Cells(k, "m")
Next
[f3] = "小计": [m3] = "小计"
Range("b2:n" & N - 2).Borders.ColorIndex = 5
Range("b2:n" & N - 2).Borders.Weight = xlHairline
Range("b2:n" & N - 2).Borders(xlEdgeRight).LineStyle = xlDouble
Range("b2:n" & N - 2).Borders(xlEdgeLeft).LineStyle = xlDouble
Range("b2:n" & N - 2).Borders(xlEdgeBottom).LineStyle = xlDouble
Range("b2:n" & N - 2).Borders(xlEdgeTop).LineStyle = xlDouble
Range("b2:n" & N - 2).Font.ColorIndex = 7
End Sub

iwangyi

ADO+SQL+PIVOT  带格式设置功能   附件