从数据透视表缓存中重新创建源数据
我想从使用数据透视表缓存的数据透视表中提取源数据并将其放入空白电子表格中。我尝试了以下,但它返回一个应用程序定义或对象定义的错误。从数据透视表缓存中重新创建源数据
ThisWorkbook.Sheets.Add.Cells(1,1).CopyFromRecordset ThisWorkbook.PivotCaches(1).Recordset
Documentation指示PivotCache.Recordset是一个ADO类型,所以这应该工作。我确实在引用中启用了ADO库。
有关如何实现此目的的任何建议?
不幸的是,似乎没有办法在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上下文菜单),并以此方式创建一个新工作表。 – 2012-10-19 22:00:19
至少在Excel 2010下,“.Range(”B2“)。ShowDetail = True”应该是:“.Range(”A2“)。ShowDetail = True”(A2而不是B2) – tbone 2013-07-09 20:16:28
转到立即窗口并输入
?thisworkbook.PivotCaches(1).QueryType
如果你得到比7(xlADORecordset)其他东西,那么Recordset属性并不适用于这种类型的PivotCache并将返回该错误。
如果你在该行的错误,那么你的PivotCache不是基于外部数据的。
如果源数据来自的ThisWorkbook(即Excel中的数据),那么你可以使用
?thisworkbook.PivotCaches(1).SourceData
通过它创建一个范围对象和循环。
如果你的查询类型为1(xlODBCQuery),然后SourceData将包含连接字符串和CommandText中为你创造和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返回存储源数据的外部工作簿的路径。数据透视表是使用来自外部工作簿(数据透视表(1).SaveData为True)的数据创建的,该数据已被删除。我想从数据透视缓存中重新创建原始数据。 当你说“从SourceData创建一个范围对象并循环它”我猜你的意思是使用Range(SourceData)引用由SourceData指定的范围对象,但这对我没有用。 感谢您的帮助。 – Kuyenda 2009-09-19 15:15:06
如果双击数据透视表中的某个单元格,或右键单击并选择“显示详细信息”,则Excel将该计算的源数据导出到同一工作簿中的新电子表格上。然而,你一次只能做一个单元。我需要为整个数据透视表执行此操作,然后自动执行此过程。 – Kuyenda 2009-09-19 15:26:15
我发现自己也遇到了同样的问题,需要以编程方式擦除与缓存的Pivot数据不同的数据。 尽管主题有点旧,但仍然没有直接访问数据的方式。
您可以在下面找到我的代码,这是对已发布解决方案的更广泛的改进。
主要区别在于筛选器从字段中删除,因为有时枢轴附带了筛选器,并且如果您调用.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
什么是的ThisWorkbook的'运行时的值。的PivotCaches(1).Recordset'? – shahkalpesh 2009-09-18 02:42:09
这是一个与总记录= 49的记录,但如果我尝试做以下我也得到应用程序定义或对象定义的错误: 昏暗objRecordset作为ADODB.Recordset 设置objRecordset = ThisWorkbook.PivotCaches(1).Recordset – Kuyenda 2009-09-18 03:13:53
将ThisWorkbook.PivotCaches(1).Recordset放入监视窗口中,查看它的确切类型。这应该有所帮助。 – shahkalpesh 2009-09-18 03:47:45