VBA無法顯示數據透視表

Question

我正在嘗試自動完成報告。第一步是創建一個數據透視表，我認爲數據透視表正在創建，但我無法在表單上查看。

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

Answer 1

得到的代碼終於工作。使用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 

Answer 2

它看起來像問題是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") 

編輯：

使用此設置普蘭奇：

Set prange = Range(ws.Range("A1"), ws.Range("A1").Offset(totalrows, totalcolumns - 1)) 

我的代碼的問題是它添加了一個額外的列umn（這是空白的），並且會拋出一個錯誤。