用于在Excel 2010中生成数据透视表的VBA代码

Question

我有一本每周都会更新的工作簿。工作表（名为 W1715.2 ）很大，范围 A1 到 AN1813 （截至本周），范围可能会发生变化周。

我想使用这些数据生成数据透视表：

列标签为“LT验证 - 计划周数”（这是工作表中的列名）

行标签为“LT验证责任”（这也是工作表中的列名）

值为计数 “ID”（这也是工作表中的列名）

报告过滤器 “构建”和“当前状态”和“问题类型”

我有一个如下所示的代码，但它只创建了一个名为数据透视表的新工作表，但它没有给我任何数据透视表！此外，该代码不包含报告过滤器，因为我不知道该怎么做！

在这里，我正在寻找帮助来生成具有上述要求的数据透视表。

1）每周更换动态范围。

2）数据透视表，包含相应的列，行标签和报告过滤器以及值的计数。

3）数据透视表应该每周都在一个新的工作表上

请查看以下代码：

Public Sub Create_Pivot_Table()

Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long

'Delete Preivous Pivot Table Worksheet & Insert a New Blank Worksheet With Same Name
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("W1715.2")

'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PRIMEPivotTable")

'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable_(TableDestination:=PSheet.Cells(1, 1), TableName:="PRIMEPivotTable")

'Insert Row Fields
With ActiveSheet.PivotTables("PRIMEPivotTable").PivotFields("LT verification responsible")
 .Orientation = xlRowField
 .Position = 1
End With

'Insert Column Fields
With ActiveSheet.PivotTables("PRIMEPivotTable").PivotFields("LT Verification - Planned Week Numbers")
 .Orientation = xlColumnField
 .Position = 1
End With

'Insert Data Field
With ActiveSheet.PivotTables("PRIMEPivotTable").PivotFields("ID")
 .Orientation = xlDataField
 .Position = 1
 .Function = xlCount
 .Name = "Names"
End With

'Format Pivot Table
ActiveSheet.PivotTables("PRIMEPivotTable").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("PRIMEPivotTable").TableStyle2 = "PivotStyleMedium9"

End Sub

我还包括了我希望拥有的最终数据透视表的图像。 （我已经应用了报告过滤器，因此小的数据透视表或者它非常巨大）

Answer 1

尝试这样......

Public Sub Create_Pivot_Table()

Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long

Application.ScreenUpdating = False
'Delete Preivous Pivot Table Worksheet & Insert a New Blank Worksheet With Same Name
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("W1715.2")

'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
'Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
Set PRange = DSheet.Range("A1").CurrentRegion

'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange)

'. _
'CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
'TableName:="PRIMEPivotTable")

'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(5, 1), TableName:="PRIMEPivotTable")

'Insert Row Fields
With PTable.PivotFields("LT verification responsible")
 .Orientation = xlRowField
 .Position = 1
End With

'Insert Column Fields
With PTable.PivotFields("LT Verification - Planned Week Numbers")
 .Orientation = xlColumnField
 .Position = 1
End With

'Pagefield
With PTable.PivotFields("Build")
 .Orientation = xlPageField
 .Position = 1
End With

With PTable.PivotFields("Current status")
 .Orientation = xlPageField
 .Position = 1
End With

With PTable.PivotFields("Type of issue")
 .Orientation = xlPageField
 .Position = 1
End With

'Insert Data Field
With PTable.PivotFields("ID")
 .Orientation = xlDataField
 .Position = 1
 .Function = xlCount
 .Name = "Names"
End With


'Format Pivot Table
PTable.ShowTableStyleRowStripes = True
PTable.TableStyle2 = "PivotStyleMedium9"
Application.ScreenUpdating = True
End Sub