从数据透视表vba中提取数据

Question

我有一个数据透视表，只在"coverage"上汇总"part"，仅用于接受的部分。

我希望然后将"sum of coverage"提取到另一张表。 我写了以下宏：

Sub Pull_data()
'Update the pivot table
Sheets("Pivot").PivotTables("PivotTable2").PivotCache.Refresh
'clear all filters
Sheets("Pivot").PivotTables("PivotTable2").PivotFields("Accepted").ClearAllFilters
'filters only accepted items
Sheets("Pivot").PivotTables("PivotTable2").PivotFields("Accepted").CurrentPage = "YES"
'get the last row of the pivot table
Set PT = Sheets("Pivot").PivotTables("PivotTable2")
With PT.TableRange1
    lngLastRow = .rows(.rows.Count).Row
End With
For i = 4 To lngLastRow
    'copy the coverage to destination sheet
    NEWi = i + 10
    Sheets("Destination").Range("G" & NEWi) = PivotTable.GetPivotData(data_field, Range("I" & i), “Coverage”)
Next i
End Sub

我得到运行时错误'424'，

需要对象

Sheets("Destination").Range("G" & NEWi) = PivotTable.GetPivotData(data_field, Range("I" & i), “Coverage”)

这是写这条线的正确方法吗？

Answer 1

这应该是：

Sheets("Destination").Range("G" & i + 10).Value = _
    pT.GetPivotData("Sum of coverage", "Part", Range("I" & i).Value).Value

因为pT.GetPivotData返回一个范围！

清理代码：

Sub Pull_data()
    Dim pT As PivotTable
    Set pT = Sheets("Pivot").PivotTables("PivotTable2")

    With pT
        '''Update the pivot table
        .PivotCache.Refresh
        '''clear all filters
        .PivotFields("Accepted").ClearAllFilters
        '''filters only accepted items
        .PivotFields("Accepted").CurrentPage = "YES"
        '''get the last row of the pivot table
        With .TableRange1
            lngLastRow = .Rows(.Rows.Count).Row
            For i = .Cells(2, 1).Row To lngLastRow
                Debug.Print "i=" & i & "|" & Sheets("Pivot").Range("I" & i).Value
                '''copy the coverage to destination sheet
                Sheets("Destination").Range("G" & i + 10).Value = _
                    pT.GetPivotData("Sum of coverage", "Part", Sheets("Pivot").Range("I" & i).Value).Value
            Next i
        End With '.TableRange1
    End With 'pT
End Sub

Answer 2

您可以尝试使用PivotTable过滤到TableRange2后的Resize整个列，使用Copy到单个列，然后{ {1}}和PasteSpecial xlValues到目标工作表。

如果下面的代码选错了列，您也可以使用Offset(0,1)来获得正确的代码。

With PT
    .TableRange2.Resize(.TableRange2.Rows.Count, 1).Copy
    Worksheets("Destination").Range("G14").PasteSpecial xlValues '<-- start Pasting from Row 14
End With

注意：如果上面的代码将列放在左侧，请尝试以下代码行：

.TableRange2.Resize(.TableRange2.Rows.Count, 1).Offset(, 1).Copy