В рамках капитального ремонта генератора отчетов я увидел то, что я считал неэффективным кодом. Эта часть кода выполняется после генерации основного отчета, чтобы установить разрывы страниц в логических позициях. Критерии таковы:
- Каждый сайт начинается на новой странице.
- Группам запрещается разбивать страницы.
Код соответствует указанному выше формату: 2 цикла выполняют эти задания.
Это оригинальный код (извините за длину):
Public Sub PageBreak(ByRef wstWorksheet As Excel.Worksheet, ByVal pctProgress As ProgressCtl.ProgressControl)
Dim breaksMoved As Integer
Dim p As HPageBreak
Dim i As Integer
'Used as a control value
breaksMoved = 1
' Marks that no rows/columns are to be repeated on each page
wstWorksheet.Activate
wstWorksheet.PageSetup.PrintTitleRows = ""
wstWorksheet.PageSetup.PrintTitleColumns = ""
'If this isn't performed beforehand, then the HPageBreaks object isn't available
Range("A3").Select
ActiveWindow.View = xlPageBreakPreview
'Defaults the print area to be the entire sheet
wstWorksheet.DisplayPageBreaks = False
wstWorksheet.PageSetup.PrintArea = ""
Range("$B$4").Select
' add breaks after each site
Do While ActiveCell.Row <= wstWorksheet.UsedRange.Rows.Count
If ActiveCell.FormulaR1C1 = "Site ID" Then
ActiveCell.PageBreak = xlPageBreakManual
End If
ActiveCell.Offset(1, 0).Activate
pctProgress.ProgressText = "Row " & CStr(ActiveCell.Row) & " of " & CStr(wstWorksheet.UsedRange.Rows.Count)
Loop
Dim passes As Long
Do While breaksMoved = 1
passes = passes + 1
breaksMoved = 0
For i = 1 To wstWorksheet.HPageBreaks.Count - 1
Set p = wstWorksheet.HPageBreaks.Item(i)
'Selects the first page break
Range(p.Location.Address).Select
'Sets the ActiveCell to 1 row above the page break
ActiveCell.Offset(-1, 0).Activate
'Move the intended break point up to the first blank section
Do While Not ActiveCell.FormulaR1C1 = ""
ActiveCell.Offset(-1, 0).Activate
breaksMoved = 1
Loop
'Add the page break
If ActiveCell.FormulaR1C1 <> "Site ID" Then
ActiveCell.Offset(1, 0).Activate
wstWorksheet.HPageBreaks.Add ActiveCell
End If
pctProgress.ProgressText = "Set break point " & CStr(passes) & "." & CStr(i)
Next
Loop
'Reset the view to normal
wstWorksheet.DisplayPageBreaks = True
ActiveWindow.View = xlNormalView
Range("A3").Select
End Sub
Видя возможности для улучшения, я принялся модифицировать это. В качестве одного из новых требований люди, желающие получить отчет, вручную удаляли страницы перед печатью. Поэтому я добавил флажки на другой странице и скопировал отмеченные элементы. Для облегчения этого я использовал именованные диапазоны. Я использовал эти именованные диапазоны для удовлетворения первого требования:
' add breaks after each site
For Each RangeName In ActiveWorkbook.Names
If Mid(RangeName.Name, 1, 1) = "P" Then
Range(RangeName).Activate
ActiveCell.Offset(Range(RangeName).Rows.Count - 1, 0).Select
ActiveCell.PageBreak = xlPageBreakManual
End If
Next RangeName
Все диапазоны имеют префикс P_ (для родителя). При использовании грубого стиля Now () с приблизительными сроками это будет на 1 секунду медленнее в моем коротком отчете за 4 сайта и более сложном отчете за 15 сайтов. Они имеют 606 и 1600 строк соответственно.
1 секунда не так уж и плоха. Давайте посмотрим на следующие критерии.
Каждая логическая группа разделена пустой строкой, поэтому самый простой способ - найти следующий разрыв страницы, вернуться назад, пока не найдете следующую пустую строку и вставить новый разрыв. Сполосните и повторите.
Так почему же оригинал проходит несколько раз? Мы тоже можем это улучшить (плита котла вне петель такая же).
Dim i As Long
Dim oPageBreak As HPageBreak
Do While i < shtDeliveryVariance.HPageBreaks.Count - 1
i = i + 1
pctProgress.ProgressText = "Setting Page Break " & CStr(i) & " of " & CStr(shtDeliveryVariance.HPageBreaks.Count)
Set oPageBreak = shtDeliveryVariance.HPageBreaks.Item(i)
' select the page break
Range(oPageBreak.Location.Address).Select
ActiveCell.Offset(-1, 0).Activate
' move up to a free row
Do While Not ActiveCell.FormulaR1C1 = ""
ActiveCell.Offset(-1, 0).Activate
Loop
'Add the page break
If ActiveCell.FormulaR1C1 <> "Site ID" Then
ActiveCell.Offset(1, 0).Activate
shtDeliveryVariance.HPageBreaks.Add ActiveCell
End If
Loop
Один проход и более элегантный тоже. Но насколько это быстрее? В маленьком тесте это занимает 54 секунды по сравнению с первоначальными 45 секундами, а в более крупном тесте мой код снова работает медленнее - от 153 до 130 секунд. И это в среднем за 3 прогона тоже.
Итак, мои вопросы: Почему мой новый код намного медленнее оригинального, несмотря на то, что мой выглядит быстрее и , что я могу сделать, чтобы ускорить медлительность кода ?
Примечание : Обновление экрана и т. Д. Уже отключено, как и расчет и т. Д.