VBA无法显示数据透视表

时间:2013-03-22 21:09:32

标签: excel-vba pivot-table displayobject vba excel

我正在尝试自动化报告。第一步是创建一个数据透视表,我认为正在创建数据透视表,但我无法在工作表上查看它。

 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

2 个答案:

答案 0 :(得分:0)

看起来问题是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))

我的代码的问题是它添加了一个额外的列(它是空白的),这将引发错误。

答案 1 :(得分:0)

让代码终于正常工作了。使用PivotTableWizard而不是添加/创建pivotcache。

以下是我的代码。还找到了一个函数.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