工作表多项目计算汇总，请大神帮忙

魂断蓝桥

ptjtlt260 发表于 2017-1-5 13:24
上传附件，请帮忙大神再看下，谢谢

Sub a()
Dim sh As Worksheet, sqt1$, sqt2$, bt, i%, T$, sql$, sqa$, sqb$
bt = [{"品名","数量1","数量2","项目1","项目2","项目3","项目4","项目5","项目6","项目7","项目8","项目9","项目10","项目11","项目12","项目13","项目14","项目15","项目16"}]
For Each sh In Sheets
    If sh.Name <> "汇总" Then
        sqt1 = ""
        For i = 4 To UBound(bt)
            sqt1 = sqt1 & "数量1*" & bt(i) & " AS 项目" & i - 3 & ","
        Next
            sqt1 = Left(sqt1, Len(sqt1) - 1)
            sqa = sqa & "SELECT 品名," & sqt1 & " FROM [" & sh.Name & "$A2:T] WHERE 品名 is not null UNION ALL "
    End If
Next
sqa = Left(sqa, Len(sqa) - 11)
For i = 4 To UBound(bt)
    sqt2 = sqt2 & "SUM(" & "项目" & i - 3 & ") as 项目" & i - 3 & ","
Next
sqt2 = Left(sqt2, Len(sqt2) - 1)
sqt1 = "select 品名," & sqt2 & " from (" & sqa & ") group by 品名"
sqt2 = ""
For Each sh In Sheets
    If sh.Name <> "汇总" Then
        sqt2 = sqt2 & "select 品名,数量1,数量2" & " FROM [" & sh.Name & "$A2:T] WHERE 品名 is not null UNION ALL "
    End If
Next
sqt2 = Left(sqt2, Len(sqt2) - 11)
sqt2 = "SELECT 品名,SUM(数量1) as 数量1,SUM(数量2) as 数量2 FROM (" & sqt2 & ") GROUP BY 品名"
For i = 1 To 16
    sqb = sqb & "a.项目" & i & "/b.数量1,"
Next
sqb = Left(sqb, Len(sqb) - 1)
sql = "select a.品名,null,b.数量1,b.数量2," & sqb & " from (" & sqt1 & ") a inner join (" & sqt2 & ") b on a.品名=b.品名"
Dim cnn As Object
Set cnn = CreateObject("ADODB.CONNECTION")
cnn.Open "Provider=Microsoft.ACE.OleDb.12.0;Extended Properties='Excel 12.0;HDR=YES'; Data Source=" & ThisWorkbook.FullName
Range("a3:z9999").ClearContents
[a3].CopyFromRecordset cnn.Execute(sql)
cnn.Close: Set cnn = Nothing
End Sub

ptjtlt260

魂断蓝桥 发表于 2017-1-6 15:32
Sub a()
Dim sh As Worksheet, sqt1$, sqt2$, bt, i%, T$, sql$, sqa$, sqb$
bt = [{"品名","数量1"," ...

谢谢大神，计算正确。

魂断蓝桥

ptjtlt260 发表于 2017-1-6 16:06
谢谢大神，计算正确。

大神，绝对谈不上。

其实这个不难，就是比较繁琐。

ptjtlt260

魂断蓝桥 发表于 2017-1-6 16:11
大神，绝对谈不上。

其实这个不难，就是比较繁琐。

老师：我刚才插入一个工作表会提示运行错误，是不是不能再插入工作表？

jjmysjg

希望看到非SQL代码

ptjtlt260

魂断蓝桥 发表于 2017-1-6 15:32
Sub a()
Dim sh As Worksheet, sqt1$, sqt2$, bt, i%, T$, sql$, sqa$, sqb$
bt = [{"品名","数量1"," ...

大侠：你好！你写的这处很好用，但现在项目增加我在bt=...这包后面增加了项目17、项目18，下面也改了For i=1 TO18，但是提示错误（至少一个参数没有指定）请问这个要什么办？如果要项目要增加到50列要什么改。请指导，谢谢！
Sub a()
Dim sh As Worksheet, sqt1$, sqt2$, bt, i%, T$, sql$, sqa$, sqb$
bt = [{"品名","数量1","数量2","项目1","项目2","项目3","项目4","项目5","项目6","项目7","项目8","项目9","项目10","项目11","项目12","项目13","项目14","项目15","项目16"}]
For Each sh In Sheets
    If sh.Name <> "汇总" Then
        sqt1 = ""
        For i = 4 To UBound(bt)
            sqt1 = sqt1 & "数量1*" & bt(i) & " AS 项目" & i - 3 & ","
        Next
            sqt1 = Left(sqt1, Len(sqt1) - 1)
            sqa = sqa & "SELECT 品名," & sqt1 & " FROM [" & sh.Name & "$A2:T] WHERE 品名 is not null UNION ALL "
    End If
Next
sqa = Left(sqa, Len(sqa) - 11)
For i = 4 To UBound(bt)
    sqt2 = sqt2 & "SUM(" & "项目" & i - 3 & ") as 项目" & i - 3 & ","
Next
sqt2 = Left(sqt2, Len(sqt2) - 1)
sqt1 = "select 品名," & sqt2 & " from (" & sqa & ") group by 品名"
sqt2 = ""
For Each sh In Sheets
    If sh.Name <> "汇总" Then
        sqt2 = sqt2 & "select 品名,数量1,数量2" & " FROM [" & sh.Name & "$A2:T] WHERE 品名 is not null UNION ALL "
    End If
Next
sqt2 = Left(sqt2, Len(sqt2) - 11)
sqt2 = "SELECT 品名,SUM(数量1) as 数量1,SUM(数量2) as 数量2 FROM (" & sqt2 & ") GROUP BY 品名"
For i = 1 To 16
    sqb = sqb & "a.项目" & i & "/b.数量1,"
Next
sqb = Left(sqb, Len(sqb) - 1)
sql = "select a.品名,null,b.数量1,b.数量2," & sqb & " from (" & sqt1 & ") a inner join (" & sqt2 & ") b on a.品名=b.品名"
Dim cnn As Object
Set cnn = CreateObject("ADODB.CONNECTION")
cnn.Open "Provider=Microsoft.ACE.OleDb.12.0;Extended Properties='Excel 12.0;HDR=YES'; Data Source=" & ThisWorkbook.FullName
Range("a3:z9999").ClearContents
[a3].CopyFromRecordset cnn.Execute(sql)
cnn.Close: Set cnn = Nothing
End Sub

魂断蓝桥

ptjtlt260 发表于 2019-3-15 09:46
大侠：你好！你写的这处很好用，但现在项目增加我在bt=...这包后面增加了项目17、项目18，下面也改了For  ...

至少一个参数没有指定

一般是一个字段没有找到，你再看看是不是标题字段有空格什么的原因。

ptjtlt260

魂断蓝桥 发表于 2019-3-15 11:12
至少一个参数没有指定

一般是一个字段没有找到，你再看看是不是标题字段有空格什么的原因。

是的，标题字段有些列是不需要的，我把那些不需的的标题字段删掉了，这样不行吗？我总共有项目17个，For i=1 To 16这个不改的话，项目1没有数据，改成1 To 17则显示至少一个参数没有指定

魂断蓝桥

ptjtlt260 发表于 2019-3-15 11:51
是的，标题字段有些列是不需要的，我把那些不需的的标题字段删掉了，这样不行吗？我总共有项目17个，For  ...

字段名称对应表格中的标题

注意下区域的选择，比如 [数据$A1:D1]

ptjtlt260

魂断蓝桥 发表于 2019-3-15 13:01
字段名称对应表格中的标题

注意下区域的选择，比如 [数据$A1:D1]

可以了，谢谢老师，还有个问题，项目要增加，但下面这句显示“标识筏太长”。最多只能增加到项目26！这个要什么解决？
bt = [{"品名","数量1","数量2","项目1","项目2","项目3","项目4","项目5","项目6","项目7","项目8","项目9","项目10","项目11","项目12","项目13","项目14","项目15","项目16"}]