VBA 数据透视表

Question

我正在尝试编写一些 VBA，它将在新选项卡中构建数据透视表。当我运行代码时，在创建数据透视表缓存时出现类型不匹配错误。

代码如下，任何帮助将不胜感激......希望重新审视它可以发现我缺少的东西

Sub makeAPivotTable()

    Dim sSheet, sSheet2 As Worksheet 'sSheet is where the data is, sSheet2 is where the pivot will be built
    Dim cCache As PivotCache
    Dim ptTable As PivotTable
    Dim rRange As Range
    Dim rLastRow, cLastColumn As Long

    ' Insert the new sheet for the pivot table to reside
    Application.DisplayAlerts = False
    Sheets.Add Before:=ActiveSheet
    ActiveSheet.name = "PivotTable"
    Application.DisplayAlerts = True
    Set sSheet2 = Worksheets("PivotTable")
    Set sSheet = Worksheets("Interactions db")

    ' define the range (the data that you want to put into the pivot table
    rLastRow = sSheet.Cells(Rows.Count, 1).End(xlUp).Row
    cLastColumn = sSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Set rRange = sSheet.Cells(1, 1).Resize(rLastRow, cLastColumn)

    ' create the cache for the pivot table
    Set cCache = ActiveWorkbook.PivotCaches.Create _
    (SourceType:=xlDatabase, SourceData:=rRange). _
    CreatePivotTable(TableDestination:=sSheet2.Cells(2, 2), _
    TableName:="SalesPivotTable")


    ' insert the blank table
    Set ptTable = cCache.CreatePivotTable _
        (TableDestination:=sSheet2.Cells(1, 1), TableName:="SalesPivotTable")


    'Insert Row Fields
    With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("customer")
    .Orientation = xlRowField
    .Position = 1
    End With


    'Insert Column Fields
    'With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Interaction Type")
    '.Orientation = xlColumnField
    '.Position = 1
    'End With

    'Insert Data Field
    With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("interactionType")
    .Orientation = xlDataField
    .Position = 1
    .Function = xlSum
    .NumberFormat = "#,##0"
    .name = "Person "
    End With


    ' do some formatting






End Sub

Answer 1

试试下面的代码（代码内解释为cmets）

Option Explicit

Sub makeAPivotTable()

    Dim sSheet As Worksheet, sSheet2 As Worksheet  ' sSheet is where the data is, sSheet2 is where the pivot will be built
    Dim cCache As PivotCache
    Dim ptTable As PivotTable
    Dim rRange As Range
    Dim rLastRow As Long, cLastColumn As Long ' need to define each one as Long, otherwise the first one is Variant

    ' Insert the new sheet for the pivot table to reside
    Application.DisplayAlerts = False

    ' 2 lines below are shorter version to create a new sheet, 
    ' assign it to sSheet2 , and name it "PivotTable"
    On Error Resume Next
    Set sSheet2 = Sheets("PivotTable") '<-- try to set the Sheet (already created in past code runs)
    On Error GoTo 0

    If sSheet2 Is Nothing Then '<-- sheet does not exist yet >> Add it
        Set sSheet2 = Sheets.Add(Before:=ActiveSheet)
        sSheet2.Name = "PivotTable"
    End If

    Application.DisplayAlerts = True

    Set sSheet = Worksheets("Interactions db")

    ' define the range (the data that you want to put into the pivot table
    With sSheet
        rLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        cLastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set rRange = .Cells(1, 1).Resize(rLastRow, cLastColumn)
    End With

    ' create the cache for the pivot table ***** THIS is the CORRECT Syntax
    Set cCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rRange)

    ' CREATE a NEW Pivot Table in sSheet2 sheet
    Set ptTable = sSheet2.PivotTables.Add(PivotCache:=cCache, TableDestination:=sSheet2.Range("A1"), TableName:="SalesPivotTable")

    With ptTable
        'Insert Row Fields
        With .PivotFields("customer")
            .Orientation = xlRowField
            .Position = 1
        End With

        'Insert Column Fields
        'With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Interaction Type")
        '.Orientation = xlColumnField
        '.Position = 1
        'End With

        'Insert Data Field
        With .PivotFields("interactionType")
            .Orientation = xlDataField
            .Position = 1
            .Function = xlSum
            .NumberFormat = "#,##0"
            .Name = "Person "
        End With

        ' do some formatting
    End With

End Sub