Оптимизация большого отчета о Excel

Question

Я ищу любые советы, которые могут помочь мне оптимизировать отчет.

Отчет состоит из сводной таблицы, которая извлекает данные из другой таблицы. Данные в сводной таблице окрашены и сгруппированы макросами VBA. Моя главная забота - это точно раскрасить и сгруппировать.

Мне нужно покрасить большую часть фона линии, а затем я должен сгруппировать их. Я читаю все строки из таблицы с данными, затем я вырезаю пять столбцов с иерархией, которая определяет правила окраски строк и группировки. Я проверяю строку за строкой, если значения соответствуют столбцам.

Пример иерархии:

CoreElement Category Subcategory  Code Product 
6   26   161    1289 3014659 
6   26   161    1245 3014655 
6   26   161    1289 3014585 
6   26   161    1282 3019640 
7   28   164    164  164 
7   7   7    7  7 
7   7   7    7  7 
5   22   142    1208 1208 
5   22   142    142  142 

раскраски:

Set oColor = Worksheets("Category_Sales").Range("A13:A" & MaxLineNumber + 13) 
For Each CellId In oColor.Cells 
k = CellId.Column 
r = CellId.Row 

    If Cells(r, 64).Value = "-1" Then 'Store Sales 
      Range("A" & r & ":AV" & r).Interior.Color = RGB(204, 255, 204) 
      Range("A" & r & ":AV" & r).Font.Bold = True 
    ElseIf Cells(r, 64).Value = Cells(r, 65).Value And Cells(r, 65).Value = Cells(r, 66).Value And Cells(r, 64) <> "" Then 'Core Element 
      Range("A" & r & ":AV" & r).Interior.Color = RGB(214, 225, 238) 
      Range("A" & r & ":AV" & r).Font.Bold = True 
    ElseIf Cells(r, 64).Value <> Cells(r, 65).Value And Cells(r, 65).Value = Cells(r, 66).Value Then 'Category 
      Range("A" & r & ":AV" & r).Interior.Color = RGB(255, 255, 204) 
    ElseIf Cells(r, 65).Value <> Cells(r, 66).Value And Cells(r, 66).Value = Cells(r, 67).Value Then 'Subcategory 
      Range("A" & r & ":AV" & r).Interior.Color = RGB(191, 191, 191) 
    ElseIf Cells(r, 66).Value <> Cells(r, 67).Value And Cells(r, 67).Value = Cells(r, 68).Value Then 'BMC 
      Range("A" & r & ":AV" & r).Interior.Color = RGB(217, 217, 217) 
    Else 
      Range("A" & r & ":AV" & r).Interior.Color = xlNone 'Product 
    End If 

Next CellId 

И макрос, который создает две первые группировки, макросы для остальных групп практически одинаковы:

k = 13 
Set oColor = Worksheets("Category_Sales").Range("A13:A" & MaxLineNumber + 13) 
For Each CellId In oColor.Cells 
r = CellId.Row 

    If Cells(r, 64).Value = "-1" Then 
      k = k + 1 
    ElseIf Cells(r, 64).Value <> Cells(r + 1, 64).Value And Cells(r, 64).Value <> "" Then 
      Rows(k & ":" & r - 1).Rows.Group 
      k = r + 1 
    End If 

Next CellId 

k = 13 
Set oColor = Worksheets("Category_Sales").Range("A13:A" & MaxLineNumber + 13) 
For Each CellId In oColor.Cells 
r = CellId.Row 

    If Cells(r, 65).Value = Cells(r, 64).Value Then 
      k = k + 1 
    ElseIf Cells(r, 65).Value <> Cells(r + 1, 65).Value And Cells(r, 65).Value <> "" Then 
      Rows(k & ":" & r - 1).Rows.Group 
      k = r + 1 

    End If 

Next CellId 

В таблица с данными я получил 22 тысячи строк. Этот отчет сохраняется как рабочая книга .xlsb.

Answer 1

Это код, который я использую в больших отчетах: Просто позвоните OnStart в начале кода и OnEnd в конце.

Public Sub OnEnd() 

    Application.ScreenUpdating = True 
    Application.EnableEvents = True 
    Application.AskToUpdateLinks = True 
    Application.DisplayAlerts = True 
    Application.Calculation = xlAutomatic 
    ThisWorkbook.Date1904 = False 

    Application.StatusBar = False 

End Sub 

Public Sub OnStart() 

    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    Application.AskToUpdateLinks = False 
    Application.DisplayAlerts = False 
    Application.Calculation = xlAutomatic 
    ThisWorkbook.Date1904 = False 

    ActiveWindow.View = xlNormalView 

End Sub