Как динамически получить адрес диапазона данных, а затем изменить адрес диапазона источника данных сводной таблицы?

Question

Я пытаюсь динамически получить адрес диапазона данных, а затем изменить адрес диапазона источника данных сводной таблицы.

Здесь задействованы три листа.

1) ThisWorkbook.Worksheets ("sheet1 ") - главная панель инструментов, имеет сводную диаграмму и срез, которые были перемещены из листа 2
2) ThisWorkbook.Worksheets (" sheet2 ") - сводная таблица
3) ThisWorkbook.Worksheets (" sheet3 ") - исходные данные, которые были скопированы из другой книги до запуска приведенного ниже кода.

Мой код дает

Ошибка времени выполнения 5: недопустимый вызов процедуры или аргумент

Ошибка указывает на Set pt = Pivot_sht.PivotTables(PivotName).ChangePivotCache(pc)

У меня есть две другие сводные диаграммы на моем основном листе. Используя тот же код, они исправляют sh без каких-либо проблем.

Полный код:

Option Explicit

Sub test()
    Dim daMa As Worksheet
    Dim daPerf As Worksheet
    Dim LastRow As Long
    Dim LastCol As Long
    Dim Data_sht As Worksheet
    Dim Pivot_sht As Worksheet
    Dim DataRange As Range
    Dim PivotName As String
    Dim NewRangePH As String
    Dim pt As PivotTable
    Dim pc As PivotCache

    'REFRESHING PERFORMANCE HISTORY

    'Set Variables Equal to Data Sheet and Pivot Sheet
    Set Data_sht = ThisWorkbook.Worksheets("sheet3")
    Set Pivot_sht = ThisWorkbook.Worksheets("sheet2")

    'Enter in Pivot Table Name
    PivotName = "PHPivot"

    With Data_sht
        .Activate

        'Dynamically Retrieve Range Address of Data
        LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
        LastCol = 12

        Set DataRange = Data_sht.Range(Cells(LastRow, 1).Address, Cells(1, LastCol).Address)

    End With

    NewRangePH = Data_sht.Name & "!" & _
    DataRange.Address(ReferenceStyle:=xlR1C1)

    'Make sure every column in data set has a heading and is not blank (error prevention)
    If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
        MsgBox "One of your data columns has a blank heading." & vbNewLine _
          & "Please fix and re-run!.", vbCritical, "Column Heading Missing!"
        Exit Sub
    End If

    'Change Pivot Table Data Source Range Address
    Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRangePH)
    Set pt = Pivot_sht.PivotTables(PivotName).ChangePivotCache(pc)

End Sub

Я просматривал многие результаты Google и результаты из Переполнения стека и пробовал по крайней мере 10 различных вещей до того разместив этот вопрос.

Answer 1

"set pt =" - это проблема, вы не хотите устанавливать новую сводную таблицу. Вместо этого используйте

Pivot_sht.PivotTables(PivotName).ChangePivotCache ActiveWorkbook. _
    PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    newRangePH, Version:=xlPivotTableVersion15)