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

VBA-数据透视表

1 个答案: