VBA не может отобразить сводную таблицу
Я пытаюсь автоматизировать отчет. Первым шагом является создание сводной таблицы, и я думаю, что сводная таблица создается, но я не могу просмотреть ее на листе.
Sub CurrentPipelineView()
Dim pt As PivotTable
Dim ptcache As PivotCache
Dim pf As PivotField
Dim pi As PivotItem
Dim ws As Worksheet
Dim wspivot As Worksheet
Dim datasheetname As String
Dim totalrows As Integer
Dim tottalcolumns As Integer
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "PivotTest1" Then
ws.Delete
End If
Next
'Setting sheet names
SheetName = "Data" 'storing sheet name which will be default
Set ws = Worksheets(SheetName)
Sheets.Add.Name = "PivotTest1"
Set wspivot = Worksheets("PivotTest1")
wspivot.Select 'Activating worksheet
'Delete any prior pivot tables
On Error Resume Next
For Each CurrentViewPt In wspivot.PivotTables
CurrentViewPt.TableRange2.Clear
Next CurrentViewPt
'Defining pivot table cache
ws.Select
totalcolumns = ws.Cells(1, Columns.Count).End(xlToLeft).Column
totalrows = ws.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count 'Counting total rows
Set PRange = ws.Range("A1").Offset(totalrows, totalcolumns)
Set ptcache = ActiveWorkbook.PivotCaches.Create(xlDatabase, PRange)
'Create pivot table
wspivot.Select
Set pt = ActiveSheet.PivotTables.Add(ptcache, Range("A3"), "PipelineView")
End Sub
Я хочу взять данные с первого листа, которые будут сгенерированы из базы данных, и использовать их для составления отчетов.
Чтобы сделать правильный круг, я хочу отладить поле кода по полю, чтобы убедиться, что я добавляю правильные поля. Когда я запускаю это, я не вижу сводной таблицы на листе, как если бы я делал это вручную в Excel.
Спасибо и С уважением, Варун
2 ответа
Получил код, наконец, работает. Использовал PivotTableWizard вместо добавления / создания сводной кэш-памяти.
Ниже мой код. Также найдена функция.UsedRange для выбора используемых диапазонов
Public Sub CountingRows()
Dim ws As Worksheet
Dim SheetName As String 'data sheet name
Dim TotalRows As Integer 'counts total number of rows
Dim TotalColumns As Integer 'sets total number of columns
Dim Counter As Integer 'Counter to start the loop
Dim wsPivot As Worksheet
Dim CreatePt As PivotTable 'creates using pivot table wizard
Dim CurrentViewPt As PivotTable
Dim PRange As Range
Dim PTCache As PivotCache
Dim PF As PivotField
'Deleting sheet if it already exists
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "PivotTest1" Then
ws.Delete
End If
Next
'Setting sheet names
SheetName = "Sheet 1" 'storing sheet name which will be default
Set ws = Worksheets(SheetName)
Sheets.Add.Name = "PivotTest1"
Set wsPivot = Worksheets("PivotTest1")
wsPivot.Select 'Activating worksheet
'Delete any prior pivot tables
On Error Resume Next
For Each CurrentViewPt In wsPivot.PivotTables
CurrentViewPt.TableRange2.Clear
Next CurrentViewPt
'Defining pivot table cache
ws.Select
TotalColumns = ws.Cells(1, Columns.Count).End(xlToLeft).Column 'Counting total columns
TotalRows = ws.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count 'Counting total rows
Set PRange = ws.UsedRange 'found a new function to use do not need to use above fields, but keeping them just incase
'Set PRange = ws.Cells(1, 1).Resize(TotalRows, TotalColumns)<<<Not sure if it works>>>
wsPivot.Select
Set PTCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
'Create the Pivot Table
Set CreatePt = wsPivot.PivotTableWizard(SourceType:=xlDatabase, SourceData:=PRange, TableDestination:=wsPivot.Range("B4"), TableName:="CurrentNBI")
Set CurrentViewPt = wsPivot.PivotTables("CurrentNBI")
'**** Define the layout of the pivot table****
With CurrentViewPt.PivotFields("NBI_CODE")
.Orientation = xlRowField
.Position = 1
End With
With CurrentViewPt.PivotFields("CREATION_DATE")
.Orientation = xlRowField
.Position = 2
End With
With CurrentViewPt.PivotFields("BUSINESS_AREA")
.Orientation = xlRowField
.Position = 3
End With
With CurrentViewPt.PivotFields("CASE_CLASSIFICATION")
.Orientation = xlRowField
.Position = 4
End With
With CurrentViewPt.PivotFields("BOOKING_CENTER")
.Orientation = xlRowField
.Position = 5
End With
With CurrentViewPt.PivotFields("LOCATION")
.Orientation = xlRowField
.Position = 6
End With
With CurrentViewPt.PivotFields("INITIATIVE_NAME")
.Orientation = xlRowField
.Position = 7
End With
With CurrentViewPt.PivotFields("BRIEF_DESCRIPTION")
.Orientation = xlRowField
.Position = 8
End With
With CurrentViewPt.PivotFields("TARGET_ASSESSMENT_DATE")
.Orientation = xlRowField
.Position = 9
End With
With CurrentViewPt.PivotFields("ASSESSMENT_COMPLETION_DATE")
.Orientation = xlRowField
.Position = 10
End With
With CurrentViewPt.PivotFields("NBI_CODE")
.Orientation = xlDataField
.Position = 1
.xlCount = True
End With
'Setting sub-totals to zero
ActiveSheet.PivotTables("CurrentNBI").PivotFields("NBI_CODE").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("CurrentNBI").PivotFields("CREATION_DATE").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("CurrentNBI").PivotFields("BUSINESS_AREA").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("CurrentNBI").PivotFields("CASE_CLASSIFICATION").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("CurrentNBI").PivotFields("BOOKING_CENTER").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("CurrentNBI").PivotFields("LOCATION").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("CurrentNBI").PivotFields("INITIATIVE_NAME").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
End Sub
Похоже, проблема заключается в PRange
объект - это просто установка нижней правой ячейки в поле. Попробуйте изменить это на:
Set PRange = Range(ws.Range("A1"), ws.Range("A1").Offset(totalrows, totalcolumns))
Я бы также использовал ptcache.CreatePivotTable(...)
создать сводную таблицу:
Set pt = ptcache.CreatePivotTable(TableDestination:=wspivot.Range("A3"), TableName:="YourTableName")
РЕДАКТИРОВАТЬ:
Используйте это, чтобы установить PRange:
Set prange = Range(ws.Range("A1"), ws.Range("A1").Offset(totalrows, totalcolumns - 1))
Проблема с моим кодом заключалась в добавлении дополнительного столбца (который был пустым), что приводило к ошибке.