vba 从数据透视表缓存重新创建源数据
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/1442316/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Recreate Source Data from PivotTable Cache
提问by Kuyenda
I am trying to extract the source data from a PivotTable that uses a PivotTable cache and place it into a blank spreadsheet. I tried the following but it returns an application-defined or object defined error.
我正在尝试从使用数据透视表缓存的数据透视表中提取源数据并将其放入空白电子表格中。我尝试了以下操作,但它返回应用程序定义或对象定义的错误。
ThisWorkbook.Sheets.Add.Cells(1,1).CopyFromRecordset ThisWorkbook.PivotCaches(1).Recordset
Documentationindicates that PivotCache.Recordset is an ADO type, so this ought to work. I do have the ADO library enabled in references.
文档表明 PivotCache.Recordset 是一种 ADO 类型,所以这应该可以工作。我确实在引用中启用了 ADO 库。
Any suggestions on how to achieve this?
关于如何实现这一目标的任何建议?
回答by Kuyenda
Unfortunately, there appears to be no way to directly manipulate PivotCache in Excel.
不幸的是,似乎无法直接在 Excel 中操作 PivotCache。
I did find a work around. The following code extracts the the pivot cache for every pivot table found in a workbook, puts it into a new pivot table and creates only one pivot field (to ensure that all rows from the pivot cache are incorporated in the total), and then fires ShowDetail, which creates a new sheet with all of the pivot table's data in.
我确实找到了解决方法。以下代码为工作簿中找到的每个数据透视表提取数据透视缓存,将其放入新数据透视表并仅创建一个数据透视字段(以确保数据透视缓存中的所有行都包含在总数中),然后触发ShowDetail,它创建一个包含所有数据透视表数据的新工作表。
I would still like to find a way to work directly with PivotCache but this gets the job done.
我仍然想找到一种直接使用 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
回答by Dick Kusleika
Go to the Immediate Window and type
转到立即窗口并键入
?thisworkbook.PivotCaches(1).QueryType
?thisworkbook.PivotCaches(1).QueryType
If you get something other than 7 (xlADORecordset), then the Recordset property does not apply to this type of PivotCache and will return that error.
如果您得到的不是 7 (xlADORecordset),则 Recordset 属性不适用于这种类型的 PivotCache 并将返回该错误。
If you get an error on that line, then your PivotCache is not based on external data at all.
如果在那一行出现错误,那么您的 PivotCache 根本不是基于外部数据。
If your source data comes from ThisWorkbook (i.e. Excel data), then you can use
如果您的源数据来自 ThisWorkbook(即 Excel 数据),那么您可以使用
?thisworkbook.PivotCaches(1).SourceData
?thisworkbook.PivotCaches(1).SourceData
To create a range object and loop through it.
创建一个范围对象并循环遍历它。
If your QueryType is 1 (xlODBCQuery), then SourceData will contain the connection string and commandtext for you to create and ADO recordset, like this:
如果您的 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
You need the ADO reference, but you said you already have that set.
您需要 ADO 参考,但您说您已经拥有该集。
回答by vale_p
I found myself having the same problem, needing to scrape programmatically data coming different Excels with cached Pivot data. Although the topic is a bit old, still looks there is no direct way to access the data.
我发现自己遇到了同样的问题,需要使用缓存的 Pivot 数据以编程方式抓取来自不同 Excel 的数据。虽然话题有点老,但看起来还是没有直接的方法可以访问数据。
Below you can find my code, which is a more generalized refinement of the already-posted solution.
您可以在下面找到我的代码,它是对已发布解决方案的更概括的改进。
The major difference is the filter removal from fields, as sometimes pivot comes with filters on, and if you call .Showdetail it will miss filtered data.
主要区别是从 fields 中删除过滤器,因为有时枢轴带有过滤器,如果您调用 .Showdetail 它将错过过滤后的数据。
I use it to scrape from different file format without having to open them, it is serving me quite well thus far.
我用它从不同的文件格式中抓取而无需打开它们,到目前为止它对我来说非常有用。
Hope it is useful.
希望它有用。
Credit to spreadsheetguru.com on the filter cleaning routine (although I don't remember how much is original and how much is mine to be honest)
在过滤器清洁程序中归功于电子表格guru.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