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

Question

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

我想使用这些数据生成一个数据透视表:

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

行标签 作为 “LT 验证负责” (这也是工作表中的列名)

值 作为 计数 的 “身份证” (这也是工作表中的列名)

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

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

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

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