求助（跨薄按条件求和）

百草青

您好：
求和汇总表A列的组合，根据成本明细与工程明细求和。实际明细有90万条，附件仅取了几十条。恳请大神帮忙写VBA代码，谢谢！

liulang0808

http://club.excelhome.net/thread-1385473-1-1.html
字典的案例，楼主可以参考下

donghui2363

没有附件啊

百草青

donghui2363 发表于 2020-2-15 08:42
没有附件啊

您好：
求和汇总表A列的组合，根据成本明细与工程明细求和。实际明细有90万条，附件仅取了几十条。恳请大神帮忙写VBA代码，谢谢！

donghui2363

Sub 求和()
Set cn1 = CreateObject("adodb.connection")
Set rs1 = CreateObject("adodb.recordset")
Set cn2 = CreateObject("adodb.connection")
Set rs2 = CreateObject("adodb.recordset")
r = Sheet1.Range("a65536").End(xlUp).Row
arr = Sheet1.Range("a2:A" & r)
    cg = ThisWorkbook.Path & "\成功明细.xlsx"
    gc = ThisWorkbook.Path & "\工程明细.xlsx"
    cn1.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & cg
    cn2.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & gc
    ReDim brr(1 To UBound(arr), 1 To 7)
    For i = 1 To UBound(arr)
        sql = "select sum(成功金额) from [sheet1$] where 组合='" & arr(i, 1) & "'"
        rs1.Open sql, cn1, 1, 3
        k = k + 1
        brr(k, 1) = rs1.Fields(0)
        sql = "select sum(发票含税金额),sum(发票不含税金额) from [sheet1$] where 组合='" & arr(i, 1) & "'"
        rs2.Open sql, cn2, 1, 3
        brr(k, 6) = rs2.Fields(0)
        brr(k, 7) = rs2.Fields(1)
        rs1.Close
        rs2.Close
    Next i
    Sheet1.Range("e2").Resize(UBound(arr), 7) = brr
End Sub
你测试一下

zhouyuma

估计你条件汇总sumif会用吧：1、把你的数据整张表合到同一个汇总文件中，这样用方便；2，在每张表中进行汇总求和，再剪切到汇总表中，把条件改为汇总表对应的条件，3，再来一次求和，4你无表头和数据，给你一个文件参考

百草青

donghui2363 发表于 2020-2-15 13:31
Sub 求和()
Set cn1 = CreateObject("adodb.connection")
Set rs1 = CreateObject("adodb.recordset")

谢谢大神，可以用

百草青

zhouyuma 发表于 2020-2-15 13:44
估计你条件汇总sumif会用吧：1、把你的数据整张表合到同一个汇总文件中，这样用方便；2，在每张表中进行汇 ...

谢谢大神