从数据透视表缓存重新创建源数据

Posted 2023-03-27

【中文标题】从数据透视表缓存重新创建源数据

【英文标题】：Recreate Source Data from PivotTable Cache

【发布时间】：2010-11-29 08:43:39

【问题描述】：

我正在尝试从使用数据透视表缓存的数据透视表中提取源数据并将其放入空白电子表格中。我尝试了以下方法，但它返回了应用程序定义或对象定义的错误。

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

Documentation 表示 PivotCache.Recordset 是 ADO 类型，所以这应该可以工作。我确实在引用中启用了 ADO 库。

关于如何实现这一点的任何建议？

【问题讨论】：

ThisWorkbook.PivotCaches(1).Recordset 运行时的值是多少？

这是一个 recordcount = 49 的记录集，但如果我尝试执行以下操作，我也会收到应用程序定义或对象定义的错误： Dim objRecordset As ADODB.Recordset Set objRecordset = ThisWorkbook.PivotCaches(1 ).记录集

将 ThisWorkbook.PivotCaches(1).Recordset 放入监视窗口以查看它的确切类型。这应该会有所帮助。

在运行时，变量类型为 Integer/Variant。当然 objRecordset 是类型记录集。只要应用程序运行 ThisWorkbook.PivotCaches(1).Recordset 在监视窗口中显示应用程序定义或对象定义错误。让我相信也许我忘记了参考。也许某些特定于 PivotCache 的东西？感谢您的帮助。

【参考方案1】：

很遗憾，似乎无法在 Excel 中直接操作 PivotCache。

我确实找到了解决办法。以下代码为工作簿中找到的每个数据透视表提取数据透视缓存，将其放入新数据透视表并仅创建一个数据透视字段（以确保数据透视缓存中的所有行都包含在总数中），然后触发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

【讨论】：

这是一个很好的解决方法，感谢您发布它。我刚刚在 Excel 2010 中尝试过，无论出于何种原因，在 .ShowDetail 行上出现错误。但是，我可以在此代码生成的一个单元格数据透视表上手动执行 ShowDetails（通过 UI 上下文菜单），并以这种方式创建一个新工作表。

至少在 Excel 2010 下，行：".Range("B2").ShowDetail = True" 实际上应该是：".Range("A2").ShowDetail = True" (A2 而不是比 B2)

【参考方案2】：

转到立即窗口并输入

?thisworkbook.PivotCaches(1).QueryType

如果您得到的不是 7 (xlADORecordset)，则 Recordset 属性不适用于这种类型的 PivotCache 并将返回该错误。

如果您在该行收到错误，则您的 PivotCache 根本不基于外部数据。

如果您的源数据来自 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 参考，但您说您已经拥有该集合。

【讨论】：

Debug.Print ThisWorkbook.PivotCaches(1).QueryType 抛出错误。 PivotCaches(1).SourceData 返回存储源数据的外部工作簿的路径。数据透视表是使用来自外部工作簿 (PivotTable(1).SaveData 为 True) 的数据创建的，该工作簿已被删除。我想从数据透视缓存中重新创建原始源数据。当您说“从 SourceData 创建一个范围对象并循环遍历它”时，我猜您的意思是使用 Range(SourceData) 来引用 SourceData 指定的范围对象，但这对我来说不可用。感谢您的帮助。

如果您双击数据透视表中的单元格，或右键单击并选择“显示详细信息”，Excel 会将该计算的源数据导出到同一工作簿中的新电子表格中。但是，您一次只能执行一个单元格。我需要为整个数据透视表执行此操作，然后自动化该过程。

【参考方案3】：

我发现自己遇到了同样的问题，需要以编程方式使用缓存的 Pivot 数据抓取来自不同 Excel 的数据。 虽然这个话题有点老了，但看起来仍然没有直接的方法来访问数据。

您可以在下面找到我的代码，这是对已发布解决方案的更通用的改进。

主要区别在于从字段中删除过滤器，因为有时 pivot 会打开过滤器，如果您调用 .Showdetail 它会丢失过滤后的数据。

我用它从不同的文件格式中抓取，而不必打开它们，到目前为止它对我的服务很好。

希望有用。

感谢电子表格大师网站上的过滤器清洁程序（虽然我不记得有多少是原创的，老实说有多少是我的）

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