11

ピボットテーブル キャッシュを使用するピボットテーブルからソース データを抽出し、空白のスプレッドシートに配置しようとしています。次のことを試しましたが、アプリケーション定義またはオブジェクト定義のエラーが返されます。

ThisWorkbook.Sheets.Add.Cells(1,1).CopyFromRecordset ThisWorkbook.PivotCaches(1).Recordset

ドキュメントは、Pivo​​tCache.Recordset が ADO​​ タイプであることを示しているため、これは機能するはずです。参照で ADO ライブラリを有効にしています。

これを達成する方法について何か提案はありますか?

4

3 に答える 3

15

残念ながら、Excel で PivotCache を直接操作する方法はないようです。

私は回避策を見つけました。次のコードは、ワークブックで見つかったすべてのピボット テーブルのピボット キャッシュを抽出し、それを新しいピボット テーブルに配置して、ピボット フィールドを 1 つだけ作成し (ピボット キャッシュのすべての行が合計に組み込まれるようにするため)、次に起動します。 ShowDetail: ピボット テーブルのすべてのデータを含む新しいシートを作成します。

私はまだ PivotCache を直接操作する方法を見つけたいと思っていますが、これで仕事は完了です。

Public Sub ExtractPivotTableData()

    Dim objActiveBook As Workbook
    Dim objSheet As Worksheet
    Dim objPivotTable As PivotTable
    Dim objTempSheet As Worksheet
    Dim objTempPivot As PivotTable

    If TypeName(Application.Selection) <> "Range" Then
        Beep
        Exit Sub
    ElseIf WorksheetFunction.CountA(Cells) = 0 Then
        Beep
        Exit Sub
    Else
        Set objActiveBook = ActiveWorkbook
    End If

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    For Each objSheet In objActiveBook.Sheets
        For Each objPivotTable In objSheet.PivotTables
            With objActiveBook.Sheets.Add(, objSheet)
                With objPivotTable.PivotCache.CreatePivotTable(.Range("A1"))
                    .AddDataField .PivotFields(1)
                End With
                .Range("B2").ShowDetail = True
                objActiveBook.Sheets(.Index - 1).Name = "SOURCE DATA FOR SHEET " & objSheet.Index
                objActiveBook.Sheets(.Index - 1).Tab.Color = 255
                .Delete
            End With
        Next
    Next

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With

End Sub
于 2009-09-21T15:24:54.123 に答える
4

イミディエイト ウィンドウに移動し、次のように入力します。

?thisworkbook.PivotCaches(1).QueryType

7 (xlADORecordset) 以外の値を取得した場合、Recordset プロパティはこのタイプの PivotCache には適用されず、そのエラーが返されます。

その行でエラーが発生した場合、Pivo​​tCache は外部データにまったく基づいていません。

ソース データが ThisWorkbook から取得されている場合 (つまり、Excel データ)、次を使用できます。

?thisworkbook.PivotCaches(1).SourceData

範囲オブジェクトを作成してループします。

QueryType が 1 (xlODBCQuery) の場合、SourceData には、次のように、作成する接続文字列とコマンドテキスト、および ADO レコードセットが含まれます。

Sub DumpODBCPivotCache()

    Dim pc As PivotCache
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset

    Set pc = ThisWorkbook.PivotCaches(1)
    Set cn = New ADODB.Connection
    cn.Open pc.SourceData(1)
    Set rs = cn.Execute(pc.SourceData(2))

    Sheet2.Range("a1").CopyFromRecordset rs

    rs.Close
    cn.Close

    Set rs = Nothing
    Set cn = Nothing

End Sub

ADO リファレンスが必要ですが、すでにそのセットを持っているとおっしゃいました。

于 2009-09-18T14:11:52.027 に答える
0

私は同じ問題を抱えていることに気付きました。キャッシュされたピボットデータを使用して、さまざまな Excel からプログラムでデータをスクレイピングする必要があります。トピックは少し古いですが、データに直接アクセスする方法はまだないようです。

以下に、既に投稿されたソリューションのより一般化された改良である私のコードを見つけることができます。

主な違いは、fields からのフィルターの削除です。ピボットにはフィルターがオンになっている場合があり、.Showdetail を呼び出すと、フィルター処理されたデータが失われます。

私はそれを使用して、さまざまなファイル形式を開かずにスクレイピングしています。これまでのところ、非常にうまく機能しています。

それが役に立つことを願っています。

フィルター クリーニング ルーチンについては、spreadsheetguru.com の功績によるものです (ただし、どれくらいがオリジナルで、どれくらいが私のものかは覚えていません)。

Option Explicit

        Sub ExtractPivotData(wbFullName As String, Optional wbSheetName As_
 String, Optional wbPivotName As String, Optional sOutputName As String, _
Optional sSheetOutputName As String)

    ' This routine extracts full data from an Excel workbook and saves it to an .xls file.

    Dim iPivotSheetCount As Integer

Dim wbPIVOT As Workbook, wbNEW As Workbook, wsPIVOT As Worksheet
Dim wsh As Worksheet, piv As PivotTable, pf As PivotField
Dim sSaveTo As String

Application.DisplayAlerts = False
calcOFF

Set wbPIVOT = Workbooks.Open(wbFullName)

    ' loop through sheets
    For Each wsh In wbPIVOT.Worksheets
        ' if it is the sheet we want, OR if no sheet specified (in which case loop through all)
        If (wsh.name = wbSheetName) Or (wbSheetName = "") Then
            For Each piv In wsh.PivotTables

            ' remove all filters and fields
            PivotFieldHandle piv, True, True

            ' make sure there's at least one (numeric) data field
            For Each pf In piv.PivotFields
                If pf.DataType = xlNumber Then
                    piv.AddDataField pf
                    Exit For
                End If
            Next pf

            ' make sure grand totals are in
            piv.ColumnGrand = True
            piv.RowGrand = True

            ' get da data
            piv.DataBodyRange.Cells(piv.DataBodyRange.Cells.count).ShowDetail = True

            ' rename data sheet
            If sSheetOutputName = "" Then sSheetOutputName = "datadump"
            wbPIVOT.Sheets(wsh.Index - 1).name = sSheetOutputName

            ' move it to new sheet
            Set wbNEW = Workbooks.Add
            wbPIVOT.Sheets(sSheetOutputName).Move Before:=wbNEW.Sheets(1)

            ' clean new file
            wbNEW.Sheets("Sheet1").Delete
            wbNEW.Sheets("Sheet2").Delete
            wbNEW.Sheets("Sheet3").Delete

            ' save it
            If sOutputName = "" Then sOutputName = wbFullName
            sSaveTo = PathWithSlash(wbPIVOT.path) & FilenameNoExtension(sOutputName) & "_data_" & piv.name & ".xls"
            wbNEW.SaveAs sSaveTo
            wbNEW.Close
            Set wbNEW = Nothing

            Next piv
        End If
    Next wsh

wbPIVOT.Close False
Set wbPIVOT = Nothing

calcON
Application.DisplayAlerts = True

End Sub


Sub PivotFieldHandle(pTable As PivotTable, Optional filterClear As Boolean, Optional fieldRemove As Boolean, Optional field As String)
'PURPOSE: How to clear the Report Filter field
'SOURCE: www.TheSpreadsheetGuru.com

Dim pf As PivotField

Select Case field

    Case ""
    ' no field specified - clear all!

        For Each pf In pTable.PivotFields
            Debug.Print pf.name
            If fieldRemove Then pf.Orientation = xlHidden
            If filterClear Then pf.ClearAllFilters
        Next pf


    Case Else
    'Option 1: Clear Out Any Previous Filtering
    Set pf = pTable.PivotFields(field)
    pf.ClearAllFilters

    '   Option 2: Show All (remove filtering)
    '   pf.CurrentPage = "(All)"
End Select

End Sub
于 2016-05-06T12:45:48.573 に答える