运行时错误'1004'无法获取工作表类的数据透视表属性

时间:2017-08-29 12:18:27

标签: excel vba excel-vba pivot-table

我需要创建数据透视表但我正在尝试添加行字段但是我收到错误“运行时错误'1004'无法获取工作表类的数据透视表属性”

    Faulting application name: httpd.exe, version: 2.4.27.0, time stamp: 0x59616b7b
Faulting module name: libintl-8.dll, version: 0.19.4.0, time stamp: 0x00000000
Exception code: 0xc0000005
Fault offset: 0x00000000000067e2
Faulting process id: 0xd24
Faulting application start time: 0x01d320befcc84638
Faulting application path: D:\WEB_Server\Apache24\bin\httpd.exe
Faulting module path: D:\WEB_Server\PostgreSQL\pg96\bin\libintl-8.dll
Report Id: c47e5ac2-8cb2-11e7-93fc-000c296b33a1
Faulting package full name: 
Faulting package-relative application ID: 

我无法将行字段添加到枢轴,我出错了帮助我

1 个答案:

答案 0 :(得分:0)

尝试下面的代码,代码注释中的解释:

Option Explicit

Sub AutoPivotTable()

Dim Sht As Worksheet
Dim PvtSht As Worksheet
Dim SrcData As Range
Dim PvtCache As PivotCache
Dim PvtTbl As PivotTable

'-- Determine the data range you want to pivot --
' Set the Worksheet object
Set Sht = ThisWorkbook.Worksheets("FBL5N")
Set SrcData = Sht.Range("A1:M30000")

' Set the Pivot Cache from Source Data
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcData.Address(False, False, xlA1, xlExternal))

' Set the Worksheet object where the Pivot Table will be placed
Set PvtSht = ThisWorkbook.Worksheets("SUMMARY")

On Error Resume Next
'Set the pivot table object
Set PvtTbl = PvtSht.PivotTables("ZFIGLABACUS") ' check if Pivot Table already created (in past runs of this Macro)
On Error GoTo 0
If PvtTbl Is Nothing Then '<-- Pivot Table not created >> create it
    ' create a new Pivot Table in "SUMMARY" sheet
    Set PvtTbl = PvtSht.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=PvtSht.Range("I3"), TableName:="ZFIGLABACUS")
    With PvtTbl
        With .PivotFields("G/L Account")
            .Orientation = xlRowField
            .Position = 1
        End With
    End With

Else ' just refresh the Pivot cache with the updated Range
    PvtTbl.ChangePivotCache PvtCache
    PvtTbl.RefreshTable
End If

End Sub