Изменить источник данных нескольких сводных таблиц, хранящихся в одном листе

Question

Моя проблема заключается в следующем: у меня есть источник данных в листах («Источник»), который я обновляю со временем, так что количество строк увеличивается. Я хочу автоматически обновлять сводные таблицы, связанные с этим источником данных, в виде листов («Обзор») через код vba. В Sheets («Обзор») есть 2 сводные таблицы, а также графики.

Вот код:

---

Sub UpdatePivotTableRange()

Dim Data_Sheet As Worksheet
Dim Pivot_Sheet As Worksheet
Dim StartPoint As Range
Dim DataRange As Range
Dim PivotName1 As String
Dim PivotName2 As String
Dim NewRange As String
Dim LastCol As Long
Dim lastRow As Long

'Set Pivot Table & Source Worksheet
Set Data_Sheet = ThisWorkbook.Worksheets("Source")
Set Pivot_Sheet = ThisWorkbook.Worksheets("Overview")

'Enter in Pivot Table Name
PivotName1 = "PivotTable1"
PivotName2 = "PivoTable2"

'Defining Staring Point & Dynamic Range
Data_Sheet.Activate
Set StartPoint = Data_Sheet.Range("A1")
LastCol = StartPoint.End(xlToRight).Column
DownCell = StartPoint.End(xlDown).Row
Set DataRange = Data_Sheet.Range(StartPoint, Cells(DownCell, LastCol))
NewRange = Data_Sheet.Name & "!" & DataRange.Address(ReferenceStyle:=xlR1C1)

'Change Pivot Tables Data Source Range Address
Pivot_Sheet.PivotTables(PivotName1). _
ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)

Pivot_Sheet.PivotTables(PivotName2). _
ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)

'Ensure Pivot Table is Refreshed
Pivot_Sheet.PivotTables(PivotName1).RefreshTable
Pivot_Sheet.PivotTables(PivotName2).RefreshTable

'Complete Message
Pivot_Sheet.Activate
MsgBox "Your Pivot Table is now updated."

End Sub

---

Я получаю следующие ошибки:

• либо "Ошибка времени выполнения '5 ' : Недопустимый вызов процедуры или аргумент "or;
• " Ошибка времени выполнения '1004': Недопустимое имя поля сводной таблицы ".

Не могли бы вы помочь, пожалуйста?

С уважением, Леопольд `

Answer 1

Вместо адреса ячейки можно напрямую применить область диапазона.

Sub UpdatePivotTableRange()

    Dim Data_Sheet As Worksheet
    Dim Pivot_Sheet As Worksheet
    Dim StartPoint As Range
    Dim DataRange As Range
    Dim PivotName1 As String
    Dim PivotName2 As String
    Dim NewRange As String
    Dim LastCol As Long
    Dim lastRow As Long
    Dim Pv As PivotTable
    Dim Wb As Workbook
    Dim pvFD As PivotField

    Set Wb = ThisWorkbook
    'Set Pivot Table & Source Worksheet
    Set Data_Sheet = ThisWorkbook.Worksheets("Source")
    Set Pivot_Sheet = ThisWorkbook.Worksheets("Overview")


    'Enter in Pivot Table Name
    PivotName1 = "PivotTable1"
    PivotName2 = "PivoTable2"

    'Defining Staring Point & Dynamic Range
    Data_Sheet.Activate
    Set StartPoint = Data_Sheet.Range("A1")
    LastCol = StartPoint.End(xlToRight).Column
    DownCell = StartPoint.End(xlDown).Row

    With Data_Sheet
        Set DataRange = .Range(StartPoint, .Cells(DownCell, LastCol))
        'Set DataRange = StartPoint.CurrentRegion   '<~~ same upper line
    End With
    'NewRange = Data_Sheet.Name & "!" & DataRange.Address(ReferenceStyle:=xlR1C1)

    'Change Pivot Tables Data Source Range Address
    Set Pv = Pivot_Sheet.PivotTables(PivotName1)
    With Pv
        .ChangePivotCache Wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=DataRange) '<~~ directly apply range object
        .ClearTable '<~~ This is necessary because the item does not reflect well as it increases.
        .RowAxisLayout xlCompactRow
        .RefreshTable
    End With
    Set pvFD = Pv.PivotFields("id")
    With pvFD
        .Orientation = xlRowField
        .Position = 1
    End With
    Set pvFD = Pv.PivotFields("name")
    With pvFD
        .Orientation = xlRowField
        .Position = 2
    End With
    Set pvFD = Pv.PivotFields("id")
    With pvFD
        .Orientation = xlRowField
        .Position = 1
    End With
    Set pvFD = Pv.CalculatedFields.Add("Mysum", Formula:="q1-q2")
    With pvFD
        .Orientation = xlDataField
        .Position = 1
    End With



    Set Pv = Pivot_Sheet.PivotTables(PivotName2)
    With Pv
        .ChangePivotCache Wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=DataRange) '<~~ directly apply range object
        .ClearTable '<~~ This is necessary because the item does not reflect well as it increases.
        .RowAxisLayout xlOutlineRow
        .RefreshTable
    End With
    Set pvFD = Pv.PivotFields("id")
    With pvFD
        .Orientation = xlRowField
        .Position = 1
    End With
    Set pvFD = Pv.PivotFields("name")
    With pvFD
        .Orientation = xlRowField
        .Position = 2
    End With
    Set pvFD = Pv.PivotFields("id")
    With pvFD
        .Orientation = xlRowField
        .Position = 1
    End With
    Set pvFD = Pv.CalculatedFields.Add("Mymutiply", Formula:="q1*q2")
    With pvFD
        .Orientation = xlDataField
        .Position = 1
    End With

    Pivot_Sheet.Activate
    MsgBox "Your Pivot Table is now updated."

End Sub

Таблица данных

Сводная таблица