'построение настраиваемой сводной таблицы с нуля с помощью VBA

'это всего лишь пример, поэтому он подходит только для справки при построении пользовательской сводной таблицы

Option Explicit

Sub comparableIR()

Application.ScreenUpdating = False

'building a custom pivot table from scratch using VBA

'this is just an example, so it is only good for reference when building a custom pivot table

Dim pvttbl As PivotTable

Dim wsdata As Worksheet

Dim rngdata As range

Dim pvtcache As PivotCache

Dim wspvt As Worksheet

Dim pvtfld As PivotField

Dim besheet As String

Application.DisplayAlerts = False

On Error Resume Next

ThisWorkbook.Sheets("Comparable Item Report").Delete

On Error GoTo 0

Application.DisplayAlerts = True

'implement error checking capabilities

If Not Sheets("Sheet1").range("V1") = "Class" And Sheets("Sheet1").range("U1") = "ComponentItem Description" Then

MsgBox ("Error: Invalid Data")

Else

besheet = "backend"

Sheets("Sheet1").Copy After:=Sheets("Sheet1")

ActiveSheet.Name = besheet

Worksheets("backend").Activate

'backend processing

Cells(1, 20) = "Item Number"

Cells(1, 21) = "Description"

Cells(1, 22) = "Class"

Cells(1, 26) = "Size"

Cells(1, 24) = "Fee"

Worksheets.Add().Name = "Custom Report"

Set wsdata = Worksheets("backend")

Set wspvt = Worksheets("Custom Report")

wspvt.Activate

For Each pvttbl In wspvt.PivotTables

If MsgBox("Delete existing Pivot Table", vbYesNo) = vbYes Then

pvttbl.TableRange2.Clear

End If

Next pvttbl

Set rngdata = wsdata.range("A:Z")

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngdata, Version:=xlPivotTableVersion12). _

CreatePivotTable TableDestination:=wspvt.range("A2"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12

Set pvttbl = wspvt.PivotTables("PivotTable1")

pvttbl.ManualUpdate = True

With pvttbl.PivotFields("Class")

.Orientation = xlRowField

.Position = 1

End With

With pvttbl.PivotFields("Description")

.Orientation = xlRowField

.Position = 2

End With

With pvttbl.PivotFields("Item Number")

.Orientation = xlRowField

.Position = 3

End With

With pvttbl.PivotFields("Size")

.Orientation = xlRowField

.Position = 4

End With

With pvttbl.PivotFields("Fee")

.Orientation = xlRowField

.Position = 5

End With

With Worksheets("Comparable Item Report")

.range("A2").PivotTable.InGridDropZones = True

.range("A2").PivotTable.RowAxisLayout xlTabularRow

.Columns("A:D").AutoFit

End With

With pvttbl

For Each pvtfld In .PivotFields

pvtfld.Subtotals(1) = True

pvtfld.Subtotals(1) = False

Next pvtfld

End With

pvttbl.ManualUpdate = False

Application.DisplayAlerts = False

Sheets("backend").Delete

Application.DisplayAlerts = True

range("F:K").EntireColumn.Hidden = True

range("A1").Value = "Last Run Date: " & Now

With range("A1").Font

.ColorIndex = 1

.Bold = True

End With

Application.ScreenUpdating = True

Rows("4:4").Select

ActiveWindow.FreezePanes = True

Columns("B:B").columnwidth = 40

'Columns("A:W").AutoFit

'range("A:W").wraptext = True

End If

'write some instructions on utilizing pivot table

End Sub