Невозможно получить свойство PivotFields класса сводной таблицы Ошибка для сводной таблицы

Question

Я собрал несколько VBA для сводной таблицы, чтобы просто указать количество CN на человека из исходной таблицы. Я добавил фотографию своей исходной таблицы, а также то, на что я пытаюсь сделать свою сводную таблицу похожей. Я получаю сообщение об ошибке в строке With ws.PivotTables("PivotTable1").PivotFields("Type"): Невозможно получить свойство PivotFields класса PivotTable. Есть идеи?

Пример таблицы и идеальной сводной таблицы

введите описание изображения здесь

Dim ws As Worksheet
Dim wb As Workbook
Dim pc As PivotCache
Dim pt As PivotTable

Sheets("Supplier Quality").Activate

Set ws = ActiveSheet
Set wb = ThisWorkbook

Set pc = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ws.Range("Table2"))

Set pt = ws.PivotTables.Add(PivotCache:=pc, tabledestination:=ws.Range("P1"), TableName:="PivotTable1")
'
With ws.PivotTables("PivotTable1").PivotFields("Type")
    .Orientation = xlRowField
    .Position = 1
End With
With ws.PivotTables("PivotTable1").PivotFields("Task Owner2")
    .Orientation = xlColumnField
    .Position = 1
End With
ws.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
    "PivotTable1").PivotFields("Type"), "Sum of Tasks Overdue", xlSum
End Sub

Answer 1

1. ws.Range ("Таблица2") адрес: "a2: b28". Таким образом, возникает ошибка, потому что диапазон поля не включен.

2. Другие проблемы возникают, когда вы создаете сводную таблицу, а затем снова применяете ее к сводной таблице. Поэтому рекомендуется применять код refreshPivot.

Sub makePivot()
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim pc As PivotCache
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim rngDB As Range
    
    Sheets("Supplier Quality").Activate
    
    Set ws = ActiveSheet
    Set wb = ThisWorkbook
    
    Set rngDB = ws.Range("a1").CurrentRegion
    
    'Set pc = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ws.Range("Table2"))
    Set pc = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngDB)
    
    Debug.Print ws.Range("Table2").Address '<~~  A2:B24   first range a2 so error occurs.
    
    Set pt = ws.PivotTables.Add(PivotCache:=pc, tabledestination:=ws.Range("P1"), TableName:="PivotTable1")

    
    
    With ws.PivotTables("PivotTable1").PivotFields("Type")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ws.PivotTables("PivotTable1").PivotFields("Task Owner2")
        .Orientation = xlRowField
        .Position = 1
    End With
    'ws.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("Type"), "Sum of Tasks Overdue", xlSum
    Set pf = pt.PivotFields("Task Owner2")
    With pf
        .Orientation = xlDataField
        .Function = xlCount
        .Caption = "Sum of Tasks Overdue"
    End With
    'pt.AddDataField pf, "Sum of Tasks Overdue", xlCount

End Sub

refre sh код

Sub refreshPivot()
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim pc As PivotCache
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim rngDB As Range
    
    Sheets("Supplier Quality").Activate
    
    Set ws = ActiveSheet
    Set wb = ThisWorkbook
    
    Set rngDB = ws.Range("a1").CurrentRegion
    
    'Set pc = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ws.Range("Table2"))
    Set pc = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngDB)
    
    
    'Set pt = ws.PivotTables.Add(PivotCache:=pc, tabledestination:=ws.Range("P1"), TableName:="PivotTable1")
    Set pt = ws.PivotTables("PivotTable1")
    With pt
        .ChangePivotCache pc
        .ClearTable '<~~ This must be done.
        .RefreshTable
    End With
    
    With ws.PivotTables("PivotTable1").PivotFields("Type")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ws.PivotTables("PivotTable1").PivotFields("Task Owner2")
        .Orientation = xlRowField
        .Position = 1
    End With

    Set pf = pt.PivotFields("Task Owner2")
    With pf
        .Orientation = xlDataField
        .Function = xlCount
        .Caption = "Sum of Tasks Overdue"
    End With

End Sub