पिवोटटेबल कैश से स्रोत डेटा को मनोरंजन करें

Question

मैं पिवोटटेबल से स्रोत डेटा निकालने का प्रयास कर रहा हूं जो पिवोटटेबल कैश का उपयोग करता है और उसे रिक्त स्प्रेडशीट में रखता है। मैंने निम्नलिखित की कोशिश की लेकिन यह एक अनुप्रयोग परिभाषित या वस्तु परिभाषित त्रुटि देता है।

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

Documentation इंगित करता है कि PivotCache.Recordset एक ADO प्रकार है, इसलिए यह काम करना चाहिए। मेरे पास संदर्भ में एडीओ लाइब्रेरी सक्षम है।

इसे प्राप्त करने के तरीके पर कोई सुझाव?

Answer 1

दुर्भाग्यवश, एक्सेल में सीधे पिवोट कैश में हेरफेर करने का कोई तरीका नहीं प्रतीत होता है।

मुझे एक काम मिल गया। निम्न कोड कार्यपुस्तिका में पाए गए प्रत्येक पिवट तालिका के लिए पिवट कैश निकालता है, इसे एक नई पिवट तालिका में रखता है और केवल एक पिवट फ़ील्ड बनाता है (यह सुनिश्चित करने के लिए कि पिवोट कैश से सभी पंक्तियां कुल में शामिल की जाती हैं), और फिर आग ShowDetail, जो सभी पिवट तालिका के डेटा के साथ एक नई शीट बनाता है।

मैं अभी भी पिवोट कैश के साथ काम करने का कोई तरीका ढूंढना चाहता हूं लेकिन यह काम पूरा हो जाता है।

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

तत्काल विंडो पर जाएं और टाइप

? Thisworkbook.PivotCaches (1) .QueryType

आप 7 (xlADORecordset) के अलावा कुछ मिलता है, तो अभिलेख सेट संपत्ति के इस प्रकार पर लागू नहीं होता PivotCache और उस त्रुटि को वापस कर देगा।

यदि आपको उस पंक्ति में कोई त्रुटि मिलती है, तो आपका पिवोट कैश बाहरी डेटा पर आधारित नहीं है।

अपने स्रोत डेटा ThisWorkbook (अर्थात एक्सेल डेटा) से आता है, तो आप का उपयोग

? Thisworkbook.PivotCaches (1) .SourceData

इसके माध्यम से एक सीमा वस्तु और पाश बनाने के लिए कर सकते हैं।

अपने QueryType 1 है (xlODBCQuery), तो SourceData कनेक्शन स्ट्रिंग और CommandText आप को बनाने के लिए और ADO recordset, इस तरह शामिल होंगे:

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 संदर्भ की आवश्यकता है, लेकिन आप आपने कहा पहले से ही सेट है।

Answer 3

मुझे खुद को एक ही समस्या है, प्रोग्रामिंग डेटा को स्क्रैप करने की आवश्यकता है कैश पिवोट डेटा के साथ विभिन्न एक्सेल। हालांकि विषय थोड़ा पुराना है, फिर भी लगता है कि डेटा तक पहुंचने का कोई सीधा तरीका नहीं है।

नीचे आप मेरा कोड पा सकते हैं, जो पहले से पोस्ट किए गए समाधान का अधिक सामान्यीकृत परिष्करण है।

प्रमुख अंतर फ़ील्ड्स से फिल्टर हटाने को हटाता है, क्योंकि कभी-कभी पिवट फ़िल्टर के साथ आता है, और यदि आप कॉल करते हैं तो .उच्च विवरण यह फ़िल्टर किए गए डेटा को याद करेगा।

मैं इसे खोलने के बिना विभिन्न फ़ाइल प्रारूप से स्क्रैप करने के लिए इसका उपयोग करता हूं, यह अब तक मुझे काफी अच्छी तरह से सेवा दे रहा है।

आशा है कि यह उपयोगी है। दिनचर्या फिल्टर सफाई पर 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