如何使用宏更改数据透视表的源范围？

Question

每周我都有数据传入我的数据集，我需要调整它的范围。我正在尝试编写一个代码来自动执行该任务。 问题 1）没有找到这方面的标准建议。 问题2）我尝试返回的方法：“执行时间错误'5'”

Option Explicit

Sub ListPivotsInfor()
'Update 20141112
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim St As Worksheet
    Dim NewSt As Worksheet
    Dim pt As PivotTable
   
    
    Application.ScreenUpdating = False
    For Each St In ActiveWorkbook.Worksheets
        'Debug.Print St.Name
        For Each pt In St.PivotTables
                Debug.Print Worksheets("DADOS").Range("A6")
                'pt.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=, Version:=7)
                Dim ptbl As PivotTable: Set ptbl = pt
                ptbl.ChangePivotCache wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Sheets("DADOS").Range("A2:AD281"), Version:=7)
            Next
        Next
    Application.ScreenUpdating = True
End Sub

我期望代码增加传入数据的范围并更新本工作簿的所有数据透视表和图表。

Answer 1

您需要通过工作簿访问 PivotCaches。 您始终可以每次从头开始对枢轴创建进行编码，但这需要一些相当复杂的编码，但从长远来看更具适应性。

要更改数据范围，您可以执行以下操作（未经测试）：

Function Address_Full_String$(ByRef Temp_Range As Range)
Address_Full_String$ = "'[" + CStr(Temp_Range.Worksheet.Parent.Name) + "]" + CStr(Temp_Range.Worksheet.Name) + "'!" + CStr(Temp_Range.Address(, , xlR1C1))
End Function

Sub modifyPivot()
Dim DataWS As Worksheet
Dim newRange As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'The worksheet where your data is - You can also address it by "name" instead of using 1
Set DataWS = ThisWorkbook.Worksheets(1)

'Get the last cell of your new data
Set newRange = DataWS.Cells.SpecialCells(xlCellTypeLastCell)
'The pivotCahces index you want to change
ThisWorkbook.PivotCaches(1).SourceData = Address_Full_String$(newRange)

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ThisWorkbook.PivotCaches(1).Refresh
Application.DisplayAlerts = True
End Sub