Excel VBA同工作表基于不同透视表创建多透视图异常解决
问题根因
代码存在两处逻辑错误,导致同工作表内第二个透视图无法正确绑定对应透视表:
- 数据透视表重复创建:每个透视表的创建流程中,在生成PivotCache后连续两次调用
CreatePivotTable指向同一个目标单元格。第一次调用CreatePivotTable时已经在目标位置生成了透视表,第二次重复调用会造成透视表对象引用混乱,导致后续数据源识别异常。 - 图表默认绑定逻辑干扰:Excel通过
AddChart2方法新建嵌入图表时,会自动绑定当前工作表内第一个可识别的透视表作为默认数据源,仅通过SetSourceData传入透视表单元格区域无法覆盖这个默认的透视表关联,最终第二个图表始终展示第一个透视表的数据。
异常效果:
修正方案
- 移除重复的透视表创建逻辑:PivotCache创建完成后,仅需调用一次
CreatePivotTable即可生成对应透视表;同一原始数据源的多个透视表可共用同一个PivotCache,无需重复创建,可有效减小文件体积。 - 显式指定图表绑定的透视表对象:新建图表后先清空默认生成的数据源,再通过图表的
PivotLayout.PivotTable属性直接绑定目标透视表,彻底绕过默认绑定逻辑的干扰。
修正后完整代码
Sub test2() 'Declare Variables 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 Dim PvtTbl As PivotTable Dim ws As Worksheet Dim cht As Shape Dim rng As Range 'Insert a New Blank Worksheet On Error Resume Next Application.DisplayAlerts = False Application.Run "Delete_Sheet3" Sheets.Add After:=Worksheets("Sheet2") ActiveSheet.Name = "Sheet3" Application.DisplayAlerts = True Set PSheet = Worksheets("Sheet3") Set DSheet = Worksheets("Sheet1") '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) '创建所有透视表共用的PivotCache Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange) '---------- Comments 透视表 ---------- Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="CommentPivotTable") 'Insert Row Fields With PTable.PivotFields("Comments") .Orientation = xlRowField .Position = 1 End With 'Insert Data Field With PTable.PivotFields("Comments") .Orientation = xlDataField .Function = xlCount .Name = "Count of Comments" End With '---------- Hold Code 透视表 ---------- Set PTable = Nothing Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(22, 1), TableName:="HoldTbl") 'Insert Row Fields With PTable.PivotFields("Hold Code") .Orientation = xlRowField .Position = 1 End With 'Insert Data Field With PTable.PivotFields("Hold Code") .Orientation = xlDataField .Function = xlCount .Name = "Count of Hold Code" End With '---------- Stat 透视表 ---------- Set PTable = Nothing Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(44, 1), TableName:="StatTbl") 'Insert Row Fields With PTable.PivotFields("Stat") .Orientation = xlRowField .Position = 1 End With 'Insert Data Field With PTable.PivotFields("Stat") .Orientation = xlDataField .Function = xlCount .Name = "Count of Stat" End With PSheet.UsedRange.EntireColumn.AutoFit '---------- 创建透视图 ---------- Set ws = Worksheets("Sheet3") '第一个图表:绑定CommentPivotTable Set rng = ws.Range("D2:K17") Set PvtTbl = ws.PivotTables("CommentPivotTable") Set cht = ws.Shapes.AddChart2(Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height) With cht.Chart .SetSourceData Source:=Nothing .PivotLayout.PivotTable = PvtTbl .ChartTitle.Text = "Total Counts for Comments" .SetElement msoElementDataLabelOutSideEnd End With '第二个图表:绑定HoldTbl Set PvtTbl = Nothing Set cht = Nothing Set rng = Nothing Set rng = ws.Range("D23:K36") Set PvtTbl = ws.PivotTables("HoldTbl") Set cht = ws.Shapes.AddChart2(Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height) With cht.Chart .SetSourceData Source:=Nothing .PivotLayout.PivotTable = PvtTbl .ChartTitle.Text = "Total Counts for Hold Code" .SetElement msoElementDataLabelOutSideEnd End With End Sub
内容的提问来源于stack exchange,提问作者ryantanww
相关产品推荐
相关产品推荐


