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

Answer 2

我以前见过这种行为。通过创建数据透视的本质，您的WB会膨胀，就像您现在看到的那样。过去，我完全按照您的操作使用VBA来创建数据透视，然后在最后，运行一个小的脚本来复制所有内容并粘贴特殊值。这将消除大部分甚至全部的膨胀。另外，不要将WB另存为XLSX，请尝试XLSB，它比XLSX小4倍左右，并且打开/关闭速度比XLSX 4倍左右。我想知道为什么您甚至使用XLSX，因为您不能以这种格式保存宏。或者，也许您有一个可以完成所有工作的模板WB，然后只需将新报告另存为XLSX。无论如何，请考虑从现在开始使用XLSB格式。

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

2 个答案: