Размер файла 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

Я видел это поведение раньше. По самой природе создания Pivots ваш ВБ будет раздут, как вы видите сейчас. Раньше я использовал VBA для создания сводок, точно так же, как вы, и затем в конце запустил небольшой скрипт, чтобы скопировать все и вставить специальные значения. Это устранит большую часть и, возможно, все, раздувание. Кроме того, вместо сохранения вашего WB как XLSX, попробуйте XLSB, который будет примерно в 4 раза меньше, чем XLSX, и будет открываться / закрываться примерно в 4 раза быстрее, чем XLSX. Мне интересно, почему вы даже используете XLSX, потому что вы не можете сохранить макросы в этом формате. Или, может быть, у вас есть шаблон WB, который выполняет всю работу, и вы просто сохраняете новые отчеты в формате XLSX. В любом случае, рассмотрите возможность использования формата XLSB с этого момента.

Answer 2

Вы можете использовать одну и ту же сводную кэш для нескольких сводных таблиц (при условии, что они основаны на одних и тех же исходных данных).

Не проверено:

'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