仅在新工作表中插入新工作表而不是数据透视表

时间:2017-12-20 07:37:17

标签: excel vba excel-vba

我想在新工作表中自动插入数据透视表。当我运行它时,它只插入一个名为Pivot表的新工作表,但它不会创建数据透视表缓存,也不会从源表读取数据。工作表名称为Data,应根据此创建Pivot

Sub InsertPivotTable()

    Dim PSheet As Worksheet
    Dim DSheet As Worksheet
    Dim PCache As PivotCache
    Dim PTable As PivotTable
    Dim PRange As Range
    Dim LastRow As Long
    Dim LastCol As Long

    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("PivotTable").Delete
    Sheets.Add Before:=ActiveSheet
    ActiveSheet.Name = "PivotTable"
    Application.DisplayAlerts = True

    Set PSheet = Worksheets("PivotTable")
    Set DSheet = Worksheets("Data")

    LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column

    Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

    Set PCache = ActiveWorkbook.PivotCaches.Create _
        (SourceType:=xlDatabase, SourceData:=PRange). _
        CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
        TableName:="PivotTable")

    Set PTable = PCache.CreatePivotTable _
        (TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")

    With ActiveSheet.PivotTables("PivotTable").PivotFields("Last_Touch_User_Name")
        .Orientation = xlRowField
        .Position = 1
    End With

    With ActiveSheet.PivotTables("PivotTable").PivotFields("Action_Code")
        .Orientation = xlColumnField
        .Position = 1
    End With

    With ActiveSheet.PivotTables("PivotTable").PivotFields("Result_Code")
        .Orientation = xlColumnField
        .Position = 2
    End With

    With ActiveSheet.PivotTables("PivotTable").PivotFields("Medical_Manager__")
        .Orientation = xlDataField
        .Position = 1
        .Function = xlCount
    End With

End Sub

1 个答案:

答案 0 :(得分:0)

您似乎尝试将这些步骤合并或部分分开:

Set PCache = ActiveWorkbook.PivotCaches.Create _
        (SourceType:=xlDatabase, SourceData:=PRange). _
        CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
        TableName:="PivotTable")

Set PTable = PCache.CreatePivotTable _
    (TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")

实际上,您希望(根据您的变量)有两个完全独立的步骤来创建缓存,然后是pivottable:

Set PCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, SourceData:=PRange)

Set PTable = PCache.CreatePivotTable _
        (TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")

请注意On Error Resume Next并未使用On Error Goto O关闭,这可能就是您没有发现这一点的原因。

始终在模块顶部添加Option Explicit以检查变量声明,拼写等。