web-dev-qa-db-ja.com

ピボットテーブルvbaからのデータの抽出

受け入れられたパーツについてのみ、"coverage"に"part"を集約するピボットテーブルがあります。

enter image description here

次に、"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”)

その行を書くのに適切な方法はどれですか？

excelvbaexcel-vbapivot-table
5
L.Dutch - Reinstate Monica

これは次のようになります：

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
4
R3uK

_TableRange2_を使用して、必要に応じてフィルタリングした後、PivotTableから列全体をコピーし、Resizeを1つの列に使用してから、Copyを試すことができます。および_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
_
2
Shai Rado