一维表转二维表求助，对多个字段求和出现错误

踏破拖鞋

请教下各位大佬，一维表转二维表时候只对数量合计的时候正确，现在增加对金额求和就报错了，请问如何修改呀。代码如下：
Sub 结果2()
    Application.ScreenUpdating = False
    Dim AdoConn As Object
    Set AdoConn = VBA.CreateObject("ADODB.Connection")
    '打开数据库
    AdoConn.Open "Provider =Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"
    Dim rst As Object
    Set rst = VBA.CreateObject("ADODB.Recordset")
    Set rst = AdoConn.Execute("transform sum(数据) sum(金额)  select 项目, 单位  from [案例1$A:D] group by 项目, 单位 pivot 姓名", , 1)
    With Sheets("结果2")
        .Select
    '----------------此处先清除原表中所有数据----------------
        .Cells.ClearContents
        '输出标题
        Dim i As Long
        For i = 0 To rst.Fields.Count - 1
            .Range("A1").Offset(0, i).Value = rst.Fields(i).Name
            .Range("A1").Offset(0, i + 1).Value = "合计"
        Next
        '输出数据
        .Range("A2").CopyFromRecordset rst
        '取合计值
        行 = .Cells(Rows.Count, "A").End(xlUp).Row
        列 = rst.Fields.Count + 1
        .Range(Cells(2, 列), Cells(2, 列)) = "=SUM(RC[-" & 列 - 3 & "]:RC[-1])"   '列 - 3是因为列标题占用了3列
        .Range(Cells(2, 列), Cells(行, 列)).FillDown
        '加边框
        .Cells.Borders.LineStyle = xlNone
        .[A1].CurrentRegion.Borders.LineStyle = xlContinuous    '从A1起对使用区域加边框
        .Range("A1").Select
    End With
    rst.Close
    AdoConn.Close
    Set rst = Nothing
    Set AdoConn = Nothing
    Application.ScreenUpdating = True
End Sub

高个子

你这个是不是数据库语句语法不对啊？

踏破拖鞋

高个子 发表于 2023-2-14 18:53
你这个是不是数据库语句语法不对啊？

不好意思  还是初学者，想实现类似图3这样的效果（将姓名按列存放），怎么改都没改对，所以想请教下大家

cjc209

这种用数据透视表 多好

dambcer

踏破拖鞋 发表于 2023-2-14 18:59
不好意思  还是初学者，想实现类似图3这样的效果（将姓名按列存放），怎么改都没改对，所以想请教下大家

初学就玩SQL啊