Question

工作簿： 在我的工作簿中，用户使用数据完成一个表。单击命令按钮时，VBA代码（参见下文）更新另一个工作表上的数据透视表，然后根据pivotfield“ Monstertype ”中填充的不同值将此表拆分为不同的工作表（每个工作表中的每个工作表） pivotfield成为该表的新工作表。这些工作表稍后将转移到word文档。

问题： 在第一次试验中，遇到的第一个枢轴点被称为“卫生控制”，然后工作正常。在以后的试验中，它一直在寻找枢纽“卫生控制”，即使它不再存在，结果我收到它不在下标之外的错误。

Sub exportPivot()
Application.ScreenUpdating = False

Worksheets("Blad9").PivotTables("Draaitabel17").RefreshTable

Dim wbbron As Workbook
Dim wbdoel As Workbook

Dim shtbron As Worksheet
Dim shtdoel As Worksheet

Dim pvt As PivotTable
Dim pi As PivotItem

Set wbbron = ActiveWorkbook
Set shtbron = wbbron.Sheets("Blad9")
Set pvt = shtbron.PivotTables("Draaitabel17")

pvt.ShowPages Pagefield:="Monstertype"

Set wbdoel = Workbooks.Add

For Each pi In pvt.PageFields("Monstertype").PivotItems
    wbbron.Sheets(pi.Value).Move after:=wbdoel.Sheets(wbdoel.Sheets.Count) 
Next pi

Application.DisplayAlerts = False
wbdoel.Sheets(1).Delete
Application.DisplayAlerts = True

VulOfferte wbdoel

End Sub

错误发生在

上

wbbron.Sheets(pi.Value).Move after:=wbdoel.Sheets(wbdoel.Sheets.Count)

寻求帮助的呼声： 它让我发疯，请帮助。

Answer 1

以下代码将在PivotItems＆＃34; Monstertype ＆＃34;中循环显示PivotField，并将工作表复制到每个项目的已添加工作簿中其＆＃39;当前页。

Sub exportPivot()

Dim wbbron          As Workbook
Dim wbdoel          As Workbook

Dim shtbron         As Worksheet
Dim shtdoel         As Worksheet
Dim SrcData         As Range

Dim pvt             As PivotTable
Dim PvtCache        As PivotCache
Dim PvtFld          As PivotField
Dim pi              As PivotItem

Application.ScreenUpdating = False

Set wbbron = ActiveWorkbook
Set shtbron = wbbron.Sheets("Blad9")

' added a Range to dynamic read new rows that were added to the source data of the Pivot Table
' modify "Sheet1" to your Sheet's name (where the Pivot Table data is located)
Set SrcData = Sheets("Sheet1").Range("A1:C" & Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row)

' set Pivot Cache to updated Pivot Table Source Data
Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, SrcData)

Set pvt = shtbron.PivotTables("Draaitabel17")
pvt.ChangePivotCache PvtCache ' set updated Cache to Pivot Table
pvt.RefreshTable

Set PvtFld = pvt.PivotFields("Monstertype")

Set wbdoel = Workbooks.Add

' loop through all Pivot Items in Pivot Field "Monstertype" , and copy a new Sheet to added workbook for every item
For Each pi In PvtFld.PivotItems
    PvtFld.CurrentPage = pi.Name

    shtbron.Copy after:=wbdoel.Sheets(wbdoel.Sheets.Count)
    With ActiveSheet
        .Name = pi.Name
        pi.Visible = True
        'PvtFld.CurrentPage = pi.Name
    End With
   ' wbbron.Sheets(pi.Name).Copy after:=wbdoel.Sheets(wbdoel.Sheets.Count)
Next pi

Application.DisplayAlerts = False
wbdoel.Sheets(1).Delete

' you can remove also sheets(2) and (3) if you want to clean-up
'wbdoel.Sheets(2).Delete
'wbdoel.Sheets(3).Delete

Application.DisplayAlerts = True

' don't know this command (NOT IN ENGLISH)
'VulOfferte wbdoel

End Sub

Answer 2

这看起来像您的数据透视表保留从数据源部分删除的项目。这不是你的VBA代码的问题，这对我来说很好。您可以通过右键单击数据透视表的任何单元格来更改此设置，选择“数据透视表选项”。然后单击“数据”选项卡并将“保留从数据源部分删除的项目”更改为“无”。

Excel VBA导出数据透视表

2 个答案: