logo标签列表

VBA Excel文件包含多个数据透视表，导致文件大小巨大。

excelvba
5
我正在自动化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

以下是我创建六个不同数据透视表的方法，这些数据透视表都使用相同的数据源，该数据源位于同一工作簿中，并且位于工作簿的第一个工作表中。例如，我的第二个数据透视表宏代码可能如下所示。

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

我将更改的内容包括: 宏名称、工作表名称、数据透视表名称以及数据透视表中的输入行/列/值。 我的目标是减小宏创建的数据透视表文件大小，使其与我手动创建的数据透视表类似。 如果您有任何其他问题，请留言。 我会编辑问题并相应地添加细节。
可能是VBA本身导致了代码太大，如果您将代码放在WorkBook_Macro中，并从代码工作簿运行代码到数据工作簿，您将能够减小代码大小。因为现在的方式，我强烈建议您不要使用该代码（但感谢您仍然发布它！） - Hila DG
@HilaDG “可能是VBA本身导致代码如此庞大”，我不太确定您的意思，但我相信是缓存数据以创建数据透视表时的方式导致文件大小差异如此之大。我使用的代码是我认为在互联网上构建数据透视表的最常见方法。它为每个数据透视表创建一个单独的缓存，而不是在它们之间共享缓存。我想知道，如何调整代码，使我创建的所有数据透视表都共享同一个数据缓存？ :) - DSM
你的代码似乎针对每个子表格都创建了两个数据透视表，一个在A4处，一个在A1处，这是有意为之吗？你可以只创建一个数据透视缓存，并将每个数据透视表指向该缓存 - 你尝试过这样做吗？ - Tim Williams
@TimWilliams “看起来你的代码为每个子文件创建了两个可旋转表格” 哦，好发现。这是我的错误。我排除了另外两行代码，它们在不同位置创建了另一个数据透视表。但是这不会影响文件大小。 “您只需创建一个单独的缓存，并将每个数据透视表指向该缓存”，我应该如何做到这一点呢？我需要将这两个宏包含在新的子程序中，以便它们能够共享相同的缓存吗？ - DSM
@DSM 我的意思是代码本身占用了一些空间，这可能就是为什么（在下面发布的答案中）手动和自动版本之间存在轻微差异的原因。顺便说一句，请接受下面的答案，因为它看起来是正确的。 - Hila DG
2个回答
5
您可以使用相同的数据透视缓存为多个数据透视表提供支持（前提是它们都基于相同的源数据）。
未经测试：
'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
哦，看起来你分享了一个答案！我会尽快尝试并回复你。 - DSM
我已将代码应用到我的宏中。很高兴地说，大小已经显著减小，几乎与手动大小相同！关于GetPivotCache函数和静态变量，我有一个问题，因为我不熟悉它的工作原理。比如说，我创建了6个数据透视表，它们使用工作表1中的数据，就像这个线程的问题结构一样。如果我有另外6个数据透视表，它们使用工作表2中的数据。我将无法为下一个6个数据透视表使用相同的函数，因为数据透视缓存存储的是工作表1的数据，对吧？ - DSM
1
是的 - 目前在该函数中定义了一个特定的范围。您可以复制它并更改副本中的范围，或者可以创建一个单一函数，将要使用的源范围传递给该函数，但这可能比您需要的更加复杂... - Tim Williams
可以制作一个单一的函数，将要使用的源范围传递给它是可能的。我对你的答案进行了一些更改，以便GetPivotCache函数接受数据范围，这样就不必在函数本身中定义它。如果我们要使用一个单一的函数，那么我们是否需要检查数据范围是否不同，以便创建一个新的缓存？我同意这超出了问题所要求的范围，因为我将其结构化以捕捉问题的基础。我应该在一个新问题中问这个问题吗？ - DSM
0

我以前见过这种情况。创建数据透视表的本质会导致工作簿变得庞大，就像您现在看到的那样。过去我曾经使用 VBA 来创建数据透视表，就像您正在做的一样，然后在最后运行一个小脚本来执行复制全部和粘贴特殊值。这将消除大部分，甚至是全部的庞大文件。另外，不要将工作簿保存为 XLSX，尝试使用 XLSB，它的大小将比 XLSX 小大约 4 倍，打开/关闭速度也比 XLSX 快大约 4 倍。我想知道为什么您甚至还在使用 XLSX，因为您无法在该格式中保存宏。或者，您可能有一个模板工作簿来完成所有工作，并将新报告简单地保存为 XLSX。无论如何，考虑从现在开始使用 XLSB 格式。

你好！“我想知道为什么你使用XLSX，因为在那种格式下无法保存宏。” 你是对的。我已经将宏保存在一个Excel插件文件中，以便宏在任何打开的工作簿中运行。“一个小脚本，用于复制全部，并粘贴特殊值”，我一开始考虑了这个选项，但由于手动处理时文件大小相当大，我想寻找方法来保持数据透视表的原样，同时使文件大小接近手动处理时的大小。 - DSM
我怀疑是我缓存用于数据透视表的数据的方式引起了这个问题，因此我提出了如何在各种数据透视表之间共享相同缓存数据的问题。有时我有2-3个不同的数据源，从中派生出20-24个数据透视表。为20个数据透视表创建单独的缓存是不可行的！@Tim Williams提供的答案正是我需要的，但由于数据工作表中的更新或使用具有自己不同数据的不同工作表，数据范围会发生变化。Tim的解决方案适用于单个数据缓存。我将尝试使用XLSB格式！ - DSM
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接