VBA-Pivot Table

Question

Ниже приведен код для изменения сводной таблицы, может ли кто-нибудь предложить мне изменения, необходимые для создания сводной таблицы в VBA.

Sub ReversePivotTable() 
' Before running this, make sure you have a summary table with column headers. 
' The output table will have three columns. 
Dim SummaryTable As Range, OutputRange As Range 
Dim OutRow As Long 
Dim r As Long, c As Long 

On Error Resume Next 
Set SummaryTable = ActiveCell.CurrentRegion 
If SummaryTable.Count = 1 Or SummaryTable.Rows.Count < 3 Then 
    MsgBox "Select a cell within the summary table.", vbCritical 
    Exit Sub 
End If 
SummaryTable.Select 
Set OutputRange = Application.InputBox(prompt:="Select a cell for the 3-column output", Type:=8) 
' Convert the range 
OutRow = 2 
Application.ScreenUpdating = False 
OutputRange.Range("A1:C3") = Array("Column1", "Column2", "Column3") 
For r = 2 To SummaryTable.Rows.Count 
    For c = 2 To SummaryTable.Columns.Count 
     OutputRange.Cells(OutRow, 1) = SummaryTable.Cells(r, 1) 
     OutputRange.Cells(OutRow, 2) = SummaryTable.Cells(1, c) 
     OutputRange.Cells(OutRow, 3) = SummaryTable.Cells(r, c) 
     OutputRange.Cells(OutRow, 3).NumberFormat = SummaryTable.Cells(r, c).NumberFormat 
     OutRow = OutRow + 1 
    Next c 
Next r 
Application.ScreenUpdating = True 
End Sub 

Answer 1

Sub MakeAPivotTable() 

Dim pt As PivotTable 
Dim cacheofpt As PivotCache  ' this is the source data for the pt 
Dim pf As PivotField 
Dim pi As PivotItem 
Dim SummaryTable As Range 

'Sheets("sheet1").Select 
'SummaryTable = Range("B2:E5") 

On Error Resume Next 
Sheets("Sheet2").Select 
ActiveSheet.PivotTables("MyPT").TableRange2.Clear 'deletes any previous 
pivottable 

' set the cache of pt 

Sheets("Sheet1").Select 
'Set SummaryTable = Range("B2:E5") 
Set SummaryTable = ActiveCell.CurrentRegion 
    If SummaryTable.Count = 1 Or SummaryTable.Rows.Count < 3 Then 
    MsgBox "Select a cell within the summary table.", vbCritical 
    Exit Sub 
    End If 
SummaryTable.Select 
Set cacheofpt = ActiveWorkbook.PivotCaches.Create(xlDatabase, SummaryTable) 



'cretae the pivot table 
Sheets("sheet2").Select 
Set pt = ActiveSheet.PivotTables.Add(cacheofpt, Range("a1"), "MyPT") 

'put the fields in 
With pt 
'add the fields 
.PivotFields("Date").Orientation = xlRowField 
.PivotFields("Name").Orientation = xlColumnField 
.PivotFields("Product").Orientation = xlRowField 
.PivotFields("Price").Orientation = xlDataField 

'go to classic view 
.RowAxisLayout xlTabularRow 

End With 

End Sub