レポートジェネレータのオーバーホールの一環として、私は非効率的なコードであると信じているものを見ました。コードのこの部分は、メインレポートが生成された後に実行され、ページ分割を論理的な位置に設定します。基準は次のとおりです。
- 各サイトは新しいページから始まります。
- グループをページ間で分割することは許可されていません。
コードは上記の形式に従います。これらのジョブを実行する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
改善の余地があるので、これを修正することにしました。新しい要件の1つとして、レポートを必要とする人々は、印刷する前に手動でページを削除していました。そこで、別のページにチェックボックスを追加し、チェックした項目をコピーしました。それを簡単にするために、名前付き範囲を使用しました。最初の要件を満たすために、これらの名前付き範囲を使用しました。
' 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（）スタイルを使用すると、これは私の短い4サイトレポートとより挑戦的な15サイトレポートでは1秒遅くなります。これらには、それぞれ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
ワンパスでよりエレガントにも。しかし、それはどれくらい速いですか？小規模なテストでは、元の45秒と比較して54秒かかります。大規模なテストでは、コードは153〜130秒で再び遅くなります。そして、これも3回の実行で平均化されます。
だから私の質問は次のとおりです：私の新しいコードは、私の見た目が速くても元のコードよりもはるかに遅いのはなぜですか？コードの速度を上げるために何ができますか？
注：Screen.Updatingなどは、Calculationなどと同様にすでにオフになっています。