请帮忙将附档中的代码修改一下，得出sheet2 中的分类汇总结果如下，谢谢

danysy

各位高手、老师： 请帮忙将附档中的代码修改一下，得出 sheet2 中的如下分类汇总结果如下，谢谢：

hfwufanhf2006

这种不用代码，数据透视鼠标点几下就成了，数据透视专门做分类汇总的。你这个例子是其中最基本的情形之一，数据透视的强项就是各种汇总。

爱疯

http://www.excelpx.com/thread-424101-1-1.html
以前的附件吧？下面通过修改录制宏改的






'添加数据透视表，通过数据透视表向导
Sub AddPt()
    Dim pt As PivotTable
    Dim x As Range, y As Range

    Set x = Sheets(1).[a1].CurrentRegion
    Set y = Sheets(2).[a1]
    Call DelPt(y.Parent)
    Set pt = y.Parent.Parent.PivotTableWizard(xlDatabase, x, y)

    With pt
        '1）拖放字段
        .PivotFields("商品代码").Orientation = xlRowField
        .PivotFields("品名").Orientation = xlRowField
        .PivotFields("客户名称").Orientation = xlRowField
        With .PivotFields("数量")
            .Orientation = xlDataField
            .Function = xlSum
        End With

        '2）其它设置
        .PivotFields("商品代码").Subtotals(1) = False    '不显示分类汇总
        .PivotFields("品名").Subtotals(1) = False
        .PivotFields("客户名称").Subtotals(1) = False
        .ColumnGrand = False    '总计 , 对行和列禁用
        .RowGrand = False
        .RepeatAllLabels xlRepeatLabels    '重复所有项目标签
    End With
    Range("a1").CurrentRegion.EntireColumn.AutoFit
End Sub

'删除数据透视表
Sub DelPt(x As Worksheet)
    Dim pt As PivotTable
    Application.ScreenUpdating = False
    x.Cells.Clear
    For Each pt In x.PivotTables
        pt.TableRange2.Clear    '包括整个数据透视表（含页字段）的区域
    Next
End Sub


1.rar (16.09 KB, 下载次数: 12)

2019-12-9 11:24 上传

点击文件名下载附件

danysy

爱疯 发表于 2019-12-9 11:24
http://www.excelpx.com/thread-424101-1-1.html
以前的附件吧？下面通过修改录制宏改的

爱疯老师，
   谢谢您， 但我在运行时显示编译错误： 变量未定义，  显示在这句代码上 “ .RepeatAllLabels xlRepeatLabels  ”， 请帮忙看看是哪里出问题了，谢谢

爱疯

你是excel03，还是excel几？

爱疯

可能你的版本，还没有该方法。
如果删掉该句，还达不到效果，就再想办法用别的方式。

danysy

爱疯 发表于 2019-12-9 11:52
可能你的版本，还没有该方法。
如果删掉该句，还达不到效果，就再想办法用别的方式。

爱疯老师，   我用的office 2007了

爱疯

danysy 发表于 2019-12-9 12:07
爱疯老师，   我用的office 2007了

那就删掉，看看在07下的效果行不行。

danysy

爱疯 发表于 2019-12-9 14:37
那就删掉，看看在07下的效果行不行。

爱疯老师，  好的，谢谢您。