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

我有一本每周都会更新的工作簿。 该工作表（名字W1715.2 ）是巨大的，范围A1到AN1813 （截至本周），范围可能会每周更改。

我想要使​​用这个数据生成一个数据透视表：

列标签为“LTvalidation – 计划周数” （这是工作表中的列名）

行标签为“LTvalidation负责人” （这也是工作表中的一个列名）

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

报告按“构build”和“当前状态”和“问题types ” 过滤

我有一个如下所示的书面代码，但它只创build一个名为PivotTable的新工作表，但它不会给我任何数据透视表！ 此外，代码不包括报告filter，因为我不知道该怎么做！

在这里，我正在寻找帮助，以生成一个数据透视表与前面提到的要求。

1）dynamic查找范围，因为它每周都在变化。

2）数据透视表与相应的列，行标签和报告filter和值的计数。

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 

我还包括了我想要的最终数据透视表的图像。 （我已经应用了报表filter，因此小的数据透视表，否则它是非常巨大的）

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