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.

Спасибо и с уважением Варун

Varun 22.03.2013 источник

comment

поместите следующую инструкцию On Error GoTo 0 сразу после Next CurrentViewPt, чтобы проверить строку, в которой у вас возникла проблема. И дайте нам информацию, какая это линия. - Kazimierz Jawor 23.03.2013

comment

Умер при установке pt Set ptcache = ActiveWorkbook.PivotCaches.Create(xlDatabase, PRange) - Varun 23.03.2013

comment

Во-первых, проверяли ли вы переменные: totalrows и totalcolumns, отличаются ли они от 0 при отладке ошибки? - Kazimierz Jawor 23.03.2013

comment

totalrows и totalcolumns получают правильное значение, так же как и PRange, но проблема в ptcache :( - Varun 23.03.2013

Ответы (2)

arrow_upward
0
arrow_downward

Похоже, проблема заключается в объекте 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))

Проблема с моим кодом заключалась в том, что он добавлял дополнительный столбец (который был пустым), и это вызывало ошибку.

Kevin Pope 22.03.2013

comment

также пробовал Set PRange = ws.Cells(1, 1).Resize(TotalRows, TotalColumns) - Varun; 23.03.2013

arrow_upward
0
arrow_downward

Наконец-то код заработал. Используется 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

Varun 27.03.2013

VBA не может отображать сводную таблицу

Ответы (2)

Вопросы по теме