Подпрограмма VBA сильно замедляется после первого выполнения

У меня есть подпрограмма, которая генерирует отчет о работе различных портфелей в 5 семьях. Дело в том, что рассматриваемые портфели никогда не бывают одинаковыми, а количество в каждой семье - тоже. Итак, я копирую, вставляю шаблон (который форматируется и ...) и добавляю форматированную строку (содержащую формулу и ...) в нужное семейство для каждого портфеля в отчете. Все работает просто отлично, код, конечно, не оптимален и не совершенен, но он отлично работает для того, что нам нужно. Проблема не в самом коде, а в том, что когда я выполняю код в первый раз, он работает очень быстро (например, 1 секунда) ... но со второго раза код резко замедляется (почти 30 секунд для базового задание идентично первому). Я перепробовал все ручные вычисления, не обновляя экран и ... но на самом деле проблема не в этом. Это похоже на утечку памяти для меня, но я не могу найти, где проблема! Почему код запускается очень быстро, но оооочень медленнее сразу после ... Независимо от длины отчета и содержимого файла, мне нужно будет закрыть Excel и снова открыть его для каждого отчета.

** Не уверен, что у меня все ясно, но это не потому, что код увеличивает размер файла Excel или что-то в этом роде, потому что после первого (быстрого) выполнения, если я сохраняю книгу, закрываю и снова открываю ее (новое) первое выполнение снова будет очень быстрым, но если бы я сделал то же самое, без закрытия и повторного открытия, это было бы очень медленно ... ^! ^!

Dim Family As String
Dim FamilyN As String
Dim FamilyP As String
Dim NumberOfFamily As Integer
Dim i As Integer
Dim zone As Integer


Sheets("RapportTemplate").Cells.Copy Destination:=Sheets("Rapport").Cells
Sheets("Rapport").Activate

i = 3
NumberOfFamily = 0
FamilyP = Sheets("RawDataMV").Cells(i, 4)
While (Sheets("RawDataMV").Cells(i, 3) <> "") And (i < 100)

    Family = Sheets("RawDataMV").Cells(i, 4)
    FamilyN = Sheets("RawDataMV").Cells(i + 1, 4)

    If (Sheets("RawDataMV").Cells(i, 3) <> "TOTAL") And _
    (Sheets("RawDataMV").Cells(i, 2) <> "Total") Then

        If (Family <> FamilyP) Then
            NumberOfFamily = NumberOfFamily + 1
        End If
        With Sheets("Rapport")
            .Rows(i + 8 + (NumberOfFamily * 3)).EntireRow.Insert
            .Rows(1).Copy Destination:=Sheets("Rapport").Rows(i + 8 + (NumberOfFamily * 3))
            .Cells(i + 8 + (NumberOfFamily * 3), 6).Value = Sheets("RawDataMV").Cells(i, 2).Value
            .Cells(i + 8 + (NumberOfFamily * 3), 7).Value = Sheets("RawDataMV").Cells(i, 3).Value
        End With
    End If
    i = i + 1
    FamilyP = Family
Wend

For i = 2 To 10
    If Sheets("Controle").Cells(16, i).Value = "" Then
        Sheets("Rapport").Cells(1, i + 11).EntireColumn.Hidden = True
    Else
        Sheets("Rapport").Cells(1, i + 11).EntireColumn.Hidden = False
    End If
Next i
Sheets("Rapport").Cells(1, 1).EntireRow.Hidden = True

'Define printing area
zone = Sheets("Rapport").Cells(4, 3).End(xlDown).Row
Sheets("Rapport").PageSetup.PrintArea = "$D$4:$Y$" & zone


Sheets("Rapport").Calculate
Sheets("RANK").Calculate
Sheets("SommaireGroupeMV").Calculate
Sheets("SommaireGroupeAlpha").Calculate
Application.CutCopyMode = False

End Sub

Ответы на вопрос(3)

Ваш ответ на вопрос