如何用vba创建数据透视表?

用vba创建数据透视表可以使用PivotCaches对象的Create方法先创建一个透视表的缓存对象PivotCache

然后再用创建的PivotCache对象的CreatePivotTable方法创建PivotTable对象。

PivotCaches对象的Create方法的语法如下：

expression . Create( SourceType , SourceData , Version )

其中SourceType参数可以是xlConsolidation 、xlDatabase、 xlExternal  ，SourceData参数是具体的数据源，Version参数是具体的透视表的版本，可以是下表中的值：

PivotCache对象的CreatePivotTable方法创建的语法如下：

expression . CreatePivotTable( TableDestination , TableName , ReadData , DefaultVersion )

其中参数TableDestination为要放置数据透视表结果的单元格区域，TableName参数为数据透视表的名称，ReadData参数表示是否一开始就创建含有所有数据的透视表还是在有必要的时候再读取需要的数据，DefaultVersion参数表示默认的数据透视表的版本。

接下来本文介绍最简单的以单元格区域为数据源创建的数据透视表，代码如下：

Sub QQ1722187970()
    Dim oPC As PivotCache
    Dim oPT As PivotTable
    Dim oWB As Workbook
    Set oWB = Excel.ThisWorkbook
    Dim oRng As Range
    Dim oWK As Worksheet
    Set oWK = oWB.ActiveSheet
    Set oRng = oWK.UsedRange
    arr = Array("我", "你", "他")
    Set oPC = oWB.PivotCaches.Create(xlDatabase, oRng, xlPivotTableVersion14)
    With oPC
        Set oPT = .CreatePivotTable(oWK.Range("i1"), "第一个透视表")
        With oPT
            '直接将数据源更改为其它单元格区域
            .SourceData = Sheet1.Range("a1").CurrentRegion.Address(True, True, xlR1C1, True)
            '获取最新的数据透视表的数据源
            sNew = .SourceData
            '刷新透视表
            .RefreshTable
            '刷新数据源
            .Update
            .DisplayErrorString = True
            .DisplayNullString = True
            .NullString = " "
            .ErrorString = " "
            Set oPF = .PivotFields("key")
            With oPF
                '移动到行区域
                .Orientation = xlRowField
            End With
             Set oPF = .PivotFields("分类")
            With oPF
                '移动到筛选区域
                .Orientation = xlPageField
                .ClearAllFilters
                .CurrentPage = "新标"
            End With
            Set oPF = .CalculatedFields.Add("本金还款率", "='已还本金（不含复贷）'/到期本金", True)
            With oPF
                '移动到数值区域
                .Orientation = xlDataField
            End With
            Set oPF = .PivotFields("month")
            With oPF
                '移动到列区域
                .Orientation = xlColumnField
                .ClearAllFilters
                '设置要显示的字段项目
                For i = 0 To UBound(arr)
                    .PivotItems(arr(i)).Visible = True
                Next i
            End With
            '禁用行总计
            .RowGrand = False
            '以表格形式显示
            .RowAxisLayout xlTabularRow
            '重复所有项目标签
            .RepeatAllLabels xlRepeatLabels
        End With
    End With
End Sub

以下代码以单元格区域创建多重合并计算数据区域数据透视表：

Sub QQ1722187970()
    Dim oPC As PivotCache
    Dim oPT As PivotTable
    Dim oWB As Workbook
    Set oWB = Excel.ThisWorkbook
    Dim oRng As Range
    Dim oWK As Worksheet
    Set oWK = oWB.ActiveSheet
    Dim oWKR As Worksheet
    Set oWKR = Sheet5
    With oWKR
        For Each oPT In .PivotTables
            oPT.TableRange2.Delete
        Next
    End With
    Set oRng = oWK.UsedRange
    Dim sADD As String
    sADD = oRng.Address(True, True, xlR1C1, True)
    '创建多重合并计算数据区域的数据透视表
    Set oPC = oWB.PivotCaches.Create(xlConsolidation, sADD, xlPivotTableVersion15)
    With oPC
        Set oPT = .CreatePivotTable(oWKR.Range("A1"), "PT1")
        With oPT
            '禁用行总计
            .RowGrand = False
            '以表格形式显示
            .RowAxisLayout xlTabularRow
            '重复所有项目标签
            .RepeatAllLabels xlRepeatLabels
             .DisplayErrorString = True
            .DisplayNullString = True
            .NullString = " "
            .ErrorString = " "
        End With
    End With
End Sub