基于动态范围创建数据透视表



我正在尝试创建一个宏,该宏将从A18开始获取数据,找到最后一行和最后一列,然后生成一个数据透视表。我四处搜索,从网上找到的代码中提取一些零碎的东西,试图让一些东西发挥作用。

我一直收到一个1004错误,我怀疑这是因为我的代码实际上没有正确选择数据范围。

这是发生错误的代码:

Set pvtable = pvcache.CreatePivotTable(TableDestination:=pvsheet.Cells(1, 1), TableName:="Payroll")

这是所有的代码:

Dim pvtable As PivotTable
Dim pvcache As PivotCache
Dim ptrange As Range
Dim pvsheet As Worksheet
Dim pdsheet As Worksheet
Dim plr As Long
Dim plc As Long
Dim startCell As Range
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets("Pivot table").Delete 'to delete the existing pivot table in the worksheet
Worksheets.Add After:=ActiveSheet ' to add a new worksheet
ActiveSheet.Name = "Pivot Table" ' to rename the worksheet

On Error GoTo 0
Set pvsheet = Worksheets("Pivot table")
Set pdsheet = Worksheets("sheet1")
Set startCell = Range("A18")


'two variable to find Last used row and column in sheet 1, raw data'


plr = pdsheet.Cells(pdsheet.Rows.Count, startCell.Column).End(xlUp).Row
plc = pdsheet.Cells(startCell.Row, pdsheet.Columns.Count).End(xlToLeft).Column

'set range from selected data

Set ptrange = pdsheet.Cells(1, 1).Resize(plr, plc)

'pivot cahe needed for data load

Set pvcache = ActiveWorkbook.PivotCaches.Create(xlDatabase, SourceData:=ptrange)
'create empty pivot table
Set pvtable = pvcache.CreatePivotTable(TableDestination:=pvsheet.Cells(1, 1), TableName:="Payroll")
'Insert worker to Row Filed
With pvsheet.PivotTables("Payroll").PivotFields("Worker")
.Orientation = xlRowField
.Position = 1
End With
'Insert Street to Row Filed & position 2
With pvsheet.PivotTables("Payroll").PivotFields("Actual Hours")
.Orientation = xlRowField
.Position = 2
End With
'to show the pivot table in Tabular form
pvsheet.PivotTables("Payroll").RowAxisLayout xlTabularRow
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

我怀疑问题就在这个区域内,这里选择了数据范围来制作数据透视表:

Set pvsheet = Worksheets("Pivot table")
Set pdsheet = Worksheets("sheet1")
Set startCell = Range("A18")



'two variable to find Last used row and column in sheet 1, raw data'


plr = pdsheet.Cells(pdsheet.Rows.Count, startCell.Column).End(xlUp).Row
plc = pdsheet.Cells(startCell.Row, pdsheet.Columns.Count).End(xlToLeft).Column


'set range from selected data


Set ptrange = pdsheet.Cells(1, 1).Resize(plr, plc)

感谢任何帮助,谢谢

尝试定义您的范围如下。。。

Set ptrange = pdsheet.Range(startCell, pdsheet.Cells(plr, plc))

或者,或者。。。

Set pdsheet = Worksheets("sheet1")
Set startCell = pdsheet.Range("A18")
With pdsheet
plr = .Cells(.Rows.Count, startCell.Column).End(xlUp).Row
plc = .Cells(startCell.Row, .Columns.Count).End(xlToLeft).Column
Set ptrange = .Range(startCell, .Cells(plr, plc))
End With

最新更新