VBA案例7：自动生成透视表

自动生成透视表程序案例：

文本型：

Private Sub CommandButton2_Click()

Sheet5.Cells.Clear

Dim WS As Worksheet

Dim NewWS As Worksheet

Dim SourceRange As Range

Dim NewRange As Range

Dim PTC As PivotCache

Dim PVT As PivotTable

Set WS = Sheet2

Set NewWS = Sheet5

r0 = Sheet2.Range("a65536").End(xlUp).Row

'NewWS.Name = "使用VBA创建数据透视表"

Set SourceRange = WS.Cells(1, 1).Resize(r0, 48)

Set NewRange = NewWS.Range("A3")

Set PTC = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SourceRange, Version:=xlPivotTableVersion14)

Set PVT = PTC.CreatePivotTable(TableDestination:=NewRange, TableName:="透视试验", DefaultVersion:=xlPivotTableVersion14)

With PVT

    .PivotFields("统计日期").Orientation = xlRowField

    .PivotFields("统计日期").Position = 1

    .PivotFields("分中心").Orientation = xlRowField

    .PivotFields("分中心").Position = 2

    .PivotFields("部名称").Orientation = xlRowField

    .PivotFields("部名称").Position = 3

    .PivotFields("组名称").Orientation = xlRowField

    .PivotFields("组名称").Position = 4

    .PivotFields("团队长").Orientation = xlRowField

    .PivotFields("团队长").Position = 5

    .PivotFields("销售人员").Orientation = xlColumnField

    .PivotFields("销售人员").Position = 1

    .AddDataField .PivotFields("登录帐号"), "计数项:登录账号", xlCount

 '筛选分中心

    .PivotFields("分中心").PivotItems("成都）").Visible = False

    .PivotFields("分中心").PivotItems("南京").Visible = False

    .PivotFields("分中心").PivotItems("上海").Visible = False

'筛选部名称

    .PivotFields("部名称").PivotItems("01部").Visible = False

    .PivotFields("部名称").PivotItems("02部").Visible = False

    .PivotFields("部名称").PivotItems("03部").Visible = False

    .PivotFields("部名称").PivotItems("06部").Visible = False

    .PivotFields("部名称").PivotItems("05部").Visible = False

    .PivotFields("部名称").PivotItems("04部").Visible = False

    .RowAxisLayout xlTabularRow

    .RepeatAllLabels xlRepeatLabels

    .PivotFields("统计日期").Subtotals(1) = False

    .PivotFields("分中心").Subtotals(1) = False

    .PivotFields("部名称").Subtotals(1) = False

    .PivotFields("组名称").Subtotals(1) = False

    End With

    

End Sub