从数据透视表caching重新创build源数据
我正在尝试从使用数据透视表caching的数据透视表中提取源数据，并将其放入空白电子表格中。 我尝试了以下，但它返回一个应用程序定义或对象定义的错误。
ThisWorkbook.Sheets.Add.Cells(1,1).CopyFromRecordset ThisWorkbook.PivotCaches(1).Recordset 文档表明PivotCache.Recordset是一个ADOtypes，所以这应该工作。 我确实在引用中启用了ADO库。
有关如何实现这一目标的任何build议？
不幸的是，似乎没有办法在Excel中直接操作PivotCache。
我find了解决办法。 以下代码为工作簿中的每个数据透视表提取数据透视表caching，将其放入新的数据透视表中，并只创build一个数据透视表字段（以确保来自透视caching的所有行都包含在总数中），然后触发ShowDetail，它创build一个包含所有数据透视表数据的新表。
我仍然想find一种直接使用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
转到立即窗口并键入
？thisworkbook.PivotCaches（1）.QueryType
如果你得到的东西不是7（xlADORecordset），那么Recordset属性不适用于这种types的PivotCache，并将返回该错误。
如果您在该行发生错误，那么您的PivotCache根本不是基于外部数据。
如果您的源数据来自ThisWorkbook（即Excel数据），那么您可以使用
？thisworkbook.PivotCaches（1）.SourceData
创build一个范围对象并通过它循环。
如果您的QueryType是1（xlODBCQuery），那么SourceData将包含连接string和commandtext，以便您创build和ADOlogging集，如下所示：
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参考，但是你说你已经有了这个设置。
我发现自己也遇到同样的问题，需要通过编程的方式来获取不同的Excelscaching的Pivot数据。 虽然这个话题有点老了，但看起来还没有直接的方式来访问数据。
下面你可以find我的代码，这是已经发布的解决scheme的更广义的细化。
主要区别在于从字段中删除filter ，因为有时在filter开启的情况下，如果调用.Showdetail它将会丢失过滤的数据。
我用它来从不同的文件格式，而不必打开它，迄今为止服务我很好。
希望它是有用的。
感谢spreadsheetguru.com在filter清洁程序（虽然我不记得多less是原来的，多less是我的诚实）
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