Erstellen Sie Quelldaten aus dem PivotTable-Cache neu

Question

Ich versuche, die Quelldaten aus einer PivotTable zu extrahieren, die einen PivotTable-Cache verwendet, und sie in einer leeren Tabelle abzulegen.Ich habe Folgendes versucht, aber es wird ein anwendungsdefinierter oder objektdefinierter Fehler zurückgegeben.

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

Dokumentation zeigt an, dass PivotCache.Recordset ein ADO-Typ ist, daher sollte dies funktionieren.Ich habe die ADO-Bibliothek in Referenzen aktiviert.

Irgendwelche Vorschläge, wie dies erreicht werden kann?

Answer 1

Leider scheint es keine Möglichkeit, um direkt Pivotcache in Excel zu bearbeiten.

Ich habe um eine Arbeit zu finden. Der folgende Code extrahiert die der Schwenk Cache für jede Pivot-Tabelle in einer Arbeitsmappe gefunden, legt es in eine neue Pivot-Tabelle und erzeugt nur eine Pivot-Feld (um sicherzustellen, dass alle Zeilen aus dem Dreh Cache in der Gesamt aufgenommen werden), und dann Feuer showdetail, die mit allen der Pivot-Tabelle der Daten in ein neues Blatt erstellt.

Ich möchte noch einen Weg finden, direkt mit Pivotcache zu arbeiten, aber dies wird der Job zu erledigen.

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

Answer 2

Gehen Sie zum Direktfenster und geben Sie ein

?thisworkbook.PivotCaches(1).QueryType

Wenn Sie etwas anderes als 7 (xlADORecordset) erhalten, gilt die Recordset-Eigenschaft nicht für diesen PivotCache-Typ und gibt diesen Fehler zurück.

Wenn Sie in dieser Zeile eine Fehlermeldung erhalten, basiert Ihr PivotCache überhaupt nicht auf externen Daten.

Wenn Ihre Quelldaten aus ThisWorkbook stammen (d. h.Excel-Daten), dann können Sie verwenden

?thisworkbook.PivotCaches(1).SourceData

So erstellen Sie ein Bereichsobjekt und durchlaufen es.

Wenn Ihr QueryType 1 (xlODBCQuery) ist, enthält SourceData die Verbindungszeichenfolge und den Befehlstext, damit Sie ein ADO-Recordset erstellen können, etwa so:

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

Sie benötigen die ADO-Referenz, aber Sie sagten, Sie hätten diesen Satz bereits.

Answer 3

Ich fand mich mit dem gleichen Problem, um programmatisch Daten zu kratzen kommen verschiedene Zeichnet sich mit zwischengespeicherten Pivot-Daten. Obwohl das Thema ist ein bisschen alt, sieht immer noch da keine direkte Möglichkeit, auf die Daten zuzugreifen ist.

Im Folgenden finden Sie meinen Code finden, die eine allgemeinere Ausgestaltung der bereits ausgeschildert Lösung.

Der wesentliche Unterschied ist die Filterentfernung von den Feldern , wie es manchmal schwenkt auf mit Filter kommt, und wenn Sie .Showdetail nennen es gefilterten Daten entgehen lassen.

Ich benutze es aus anderem Dateiformat zu kratzen, ohne sie öffnen zu müssen, ist es mich ganz gut so weit zu dienen.

Hoffe, dass es nützlich ist.

Kredit zu spreadsheetguru.com auf dem Filterreinigungsroutine (obwohl ich mich nicht erinnern, wie viel ist originell und wie viel ist meine ehrlich zu sein)

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