包含多个数据透视表的VBA Excel文件大小非常大

Question

我正在自动化在Excel中创建数据透视表的过程.我遇到的问题是我使用我的宏创建的数据透视表比我手动创建的数据透视表大.两个数据透视表看起来都相同,但文件大小差别很大.

如上图所示,我的宏创建的大约是6倍!我怀疑这是我在创建数据透视表时缓存数据的方式.所以,这是我用来创建透视表的通用代码.

Sub pivottable1()

    Dim PSheet As Worksheet, DSheet As Worksheet
    Dim PCache As PivotCache
    Dim PTable As PivotTable
    Dim PField As PivotField
    Dim PRange As Range
    Dim LastRow As Long
    Dim LastCol As Long
    Dim PvtTable As PivotTable
    Dim SheetName As String
    Dim PTName As String

    SheetName = "MySheetName1"
    PTName = "PivotTable1"
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(SheetName).Delete
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = SheetName
    Application.DisplayAlerts = True

    Set PSheet = Worksheets(SheetName)
    Set DSheet = Worksheets(1)

    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(4, 1), _
    TABLENAME:=PTName)

    Set PTable = PCache.CreatePivotTable _
    (TableDestination:=PSheet.Cells(1, 1), TABLENAME:=PTName)

    Sheets(SheetName).Select
        Set PvtTable = ActiveSheet.PivotTables(PTName)
        'Rows
        With PvtTable.PivotFields("TypeCol")
            .Orientation = xlRowField
            .Position = 1
        End With

        With PvtTable.PivotFields("NameCol")
            .Orientation = xlRowField
            .Position = 2
        End With

        'Columns
        With PvtTable.PivotFields("CategoryCol")
            .Orientation = xlColumnField
            .Position = 1
        End With

        'Values
        PvtTable.AddDataField PvtTable.PivotFields("Values1"), "Value Balance", xlSum
        PvtTable.AddDataField PvtTable.PivotFields("Values2"), "Value 2 Count", xlCount

        With PvtTable
            .PivotFields("TypeCol").ShowDetail = False
            .TableRange1.Font.Size = 10
            .ColumnRange.HorizontalAlignment = xlCenter
            .ColumnRange.VerticalAlignment = xlTop
            .ColumnRange.WrapText = True
            .ColumnRange.Columns.AutoFit
            .ColumnRange.EntireRow.AutoFit
            .RowAxisLayout xlTabularRow
            .ShowTableStyleRowStripes = True
            .PivotFields("TypeCol").AutoSort xlDescending, "Value Balance" 'Sort descdending order
            .PivotFields("NameCol").AutoSort xlDescending, "Value Balance"
        End With

        'Change Data field (Values) number format to have thousand seperator and 0 decimal places.
        For Each PField In PvtTable.DataFields
            PField.NumberFormat = "#,##0"
        Next PField

End Sub

这就是我如何创建6个不同的数据透视表,它们都使用位于同一工作簿中的相同数据源,并且位于该工作簿的第一个工作表中.因此,例如我的第二个数据透视表宏代码看起来像这样.

Sub pivottable2()

    Dim PSheet As Worksheet, DSheet As Worksheet
    Dim PCache As PivotCache
    Dim PTable As PivotTable
    Dim PField As PivotField
    Dim PRange As Range
    Dim LastRow As Long
    Dim LastCol As Long
    Dim PvtTable As PivotTable
    Dim SheetName As String
    Dim PTName As String

    SheetName = "MySheetName2"
    PTName = "PivotTable2"
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(SheetName).Delete
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = SheetName
    Application.DisplayAlerts = True

    Set PSheet = Worksheets(SheetName)
    Set DSheet = Worksheets(1)

    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(4, 1), _
    TABLENAME:=PTName)

    Set PTable = PCache.CreatePivotTable _
    (TableDestination:=PSheet.Cells(1, 1), TABLENAME:=PTName)

    Sheets(SheetName).Select
        Set PvtTable = ActiveSheet.PivotTables(PTName)
        'Rows
        With PvtTable.PivotFields("ManagerCol")
            .Orientation = xlRowField
            .Position = 1
        End With

        With PvtTable.PivotFields("IDCol")
            .Orientation = xlRowField
            .Position = 2
        End With

        'Columns
        With PvtTable.PivotFields("CategoryCol")
            .Orientation = xlColumnField
            .Position = 1
        End With

        'Values
        PvtTable.AddDataField PvtTable.PivotFields("Values1"), "Value Balance", xlSum

End Sub

我更改的所有内容都是宏名称,工作表名称,数据透视表名称以及数据透视表的输入行/列/数据值.

我希望实现的是将宏创建的数据透视表的文件大小减小到类似于我手动创建的数据库.

如果您想知道任何额外的内容,请发表评论.我将对问题进行编辑并分别添加细节.

Answer 1

您可以对多个数据透视表使用相同的数据透视缓存（假设它们基于相同的源数据）。

未经测试：

'creates and returns a shared pivotcache object
Function GetPivotCache() As PivotCache
    Static pc As PivotCache 'static variables retain their value between calls
    Dim pRange As Range

    If pc Is Nothing Then 'create if not yet created
        Set prRange = Worksheets(1).Range("A1").CurrentRegion
        Set pc = ActiveWorkbook.PivotCaches.Create _
                     (SourceType:=xlDatabase, SourceData:=pRange)
    End If
    Set GetPivotCache = pc
End Function


Sub pivottable1()

    '...
    '...

    Set PSheet = Worksheets(SheetName)

    Set PCache = GetPivotCache() '<<< will be created if needed

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

    '...
    '...

End Sub