通过 VBA 的 Excel 分页符

Excel page breaks via VBA

提问by graham.reeds

As part of an overhaul of a report generator I saw what I believed to be inefficient code. This part of the code runs after the main report is generated to set the page breaks in logical positions. The criteria is this:

作为报告生成器大修的一部分，我看到了我认为效率低下的代码。这部分代码在生成主报表后运行，以在逻辑位置设置分页符。标准是这样的：

• Each Site starts on a new page.
• Group's aren't allowed to broken across pages.

• 每个站点都从一个新页面开始。
• 不允许跨页面拆分组。

The code follows the above format: 2 loops doing those jobs.

代码遵循上述格式：2 个循环完成这些工作。

This is the original code (sorry for the length):

这是原始代码（抱歉长度）：

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").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

Seeing room for improvement I set about modifying this. As one of the new requirements the people wanting the report were manually removing pages prior to printing. So I added checkboxes on another page and copied the checked items across. To ease that I used named ranges. I used these named ranges to meet the first requirement:

看到改进的余地，我开始修改它。作为新要求之一，需要报告的人在打印前手动删除页面。所以我在另一个页面上添加了复选框并复制了选中的项目。为了简化我使用命名范围。我使用这些命名范围来满足第一个要求：

' 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

All Ranges are prefixed with P_ (for parent). Using the lame Now() style of rough timing this is 1 second slower on my short 4 site report and the more challenging 15 site report. These have 606 and 1600 rows respectively.

所有范围都以 P_ 为前缀（对于父级）。使用蹩脚的 Now() 风格的粗略计时，这在我的简短 4 站点报告和更具挑战性的 15 站点报告中慢了 1 秒。它们分别有 606 和 1600 行。

1 second isn't so bad. Lets look at the next criteria. Each logical group is split by a blank row, so the easiest way is to find the next page break, step back until you find the next blank line and insert the new break. Rinse and repeat.

1 秒还不错。让我们看看下一个标准。每个逻辑组被一个空行分割，所以最简单的方法是找到下一个分页符，退一步直到找到下一个空行并插入新的分页符。冲洗并重复。

So why does the original run through multiple times? We can improve that too (the boiler plate outside the loops is the same).

那么为什么原版会运行多次呢？我们也可以改进它（循环外的样板是相同的）。

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

One pass and more elegant too. But how much quicker is it? On the small test is takes 54 seconds compared to the original 45 seconds, and on the larger test my code is slower again at 153 to 130 seconds. And this is averaged over 3 runs too.

一关，也更优雅。但它有多快？与原始的 45 秒相比，小型测试需要 54 秒，而在较大的测试中，我的代码在 153 到 130 秒时再次变慢。这也是 3 次运行的平均值。

So my questions are: Why is my newer code so much slower than the original despite mine looking fasterand what can I do to speed up the slowness of the code?

所以我的问题是：尽管我的新代码看起来更快，但为什么我的新代码比原始代码慢得多，我该怎么做才能加快代码的速度？

Note: Screen.Updating, etc. is already off as is Calculation etc.

注意：Screen.Updating 等已经关闭，计算等也已关闭。

回答by Oorang

I see room for improvement in a couple spots in your code:

我看到您的代码中有几个地方有改进的余地：

1. Don't access properties that are implemented slowly, like usedrange.rows.count more than once(particularly inside a loop) unless you think they may have changes. Instead store them in a variable.
2. Don't do text comparisons if you can avoid it (Ex: .Value = ""), instead use the LenB function to check for emptiness, it will execute faster as it's just reading the length of the string header instead of launching into a byte by byte string comparison. (You might enjoy thisfor reading.)
3. Don't use "Activate" or "Select" to move around the ActiveCell, just access the range directly.
4. When looping, structure your loop to have to perform as few tests as possible. If the loop must always execute once, then you want a post-test loop.
5. Make sure you have the Excel interface locked, as running events and screen-updating etc, can slow your code down a lot. (Especially events.)
6. Finally, I noticed that you are making assumptions about the case of "Site ID", unless there is no possible way it could be cased otherwise, it's best to do a case insensitive comparison. If you know for a fact that it will be Cased that way you can of course remove the calls to LCase$ that I added.

1. 不要访问执行缓慢的属性，例如 usedrange.rows.count 多次（尤其是在循环内），除非您认为它们可能有更改。而是将它们存储在变量中。
2. 如果可以避免的话，不要进行文本比较（例如：.Value = ""），而是使用 LenB 函数来检查是否为空，它会执行得更快，因为它只是读取字符串标题的长度而不是启动到逐字节字符串比较。（你可能会喜欢这个阅读。）
3. 不要使用“激活”或“选择”在 ActiveCell 中移动，直接访问范围即可。
4. 循环时，将循环构建为必须执行尽可能少的测试。如果循环必须始终执行一次，那么您需要一个测试后循环。
5. 确保您已锁定 Excel 界面，因为运行事件和屏幕更新等会大大降低您的代码速度。（特别是事件。）
6. 最后，我注意到您正在对“站点 ID”的大小写进行假设，除非没有可能的方式来区分大小写，否则最好进行不区分大小写的比较。如果您知道这样的事实，您当然可以删除我添加的对 LCase$ 的调用。

I refactored the originalcode to give you an example of some of these ideas. Without knowing your data layout, it's hard to be sure if this code is 100% valid, so I would double check it for logic errors. But it should get you started.

我重构了原始代码，为您提供其中一些想法的示例。在不知道您的数据布局的情况下，很难确定此代码是否 100% 有效，因此我会仔细检查它是否存在逻辑错误。但它应该让你开始。

Public Sub PageBreak(ByRef wstWorksheet As Excel.Worksheet, ByVal pctProgress As ProgressCtl.ProgressContro)
        Const lngColSiteID_c As Long = 2&
        Const lngColSiteIDSecondary_c As Long = 1&
        Const lngOffset_c As Long = 1&
        Dim breaksMoved As Boolean
        Dim lngRowBtm As Long
        Dim lngRow As Long
        Dim p As Excel.HPageBreak
        Dim i As Integer
        Dim passes As Long
        Dim lngHBrksUprBnd As Long
        LockInterface True
        ' Marks that no rows/columns are to be repeated on each page
        wstWorksheet.Activate
        wstWorksheet.PageSetup.PrintTitleRows = vbNullString
        wstWorksheet.PageSetup.PrintTitleColumns = vbNullString


        'If this isn't performed beforehand, then the HPageBreaks object isn't available
        '***Not true:)***

        'ActiveWindow.View = xlPageBreakPreview

        'Defaults the print area to be the entire sheet
        wstWorksheet.DisplayPageBreaks = False
        wstWorksheet.PageSetup.PrintArea = vbNullString

        ' add breaks after each site
        lngRowBtm = wstWorksheet.UsedRange.Rows.Count
        For lngRow = 4& To lngRowBtm
            'LCase is to make comparison case insensitive.
            If LCase$(wstWorksheet.Cells(lngRow, lngColSiteID_c).value) = "site id" Then
                wstWorksheet.Cells(lngRow, lngColSiteID_c).PageBreak = xlPageBreakManual
            End If
            pctProgress.ProgressText = ("Row " & CStr(lngRow)) & (" of " & CStr(lngRowBtm))
        Next

        lngHBrksUprBnd = wstWorksheet.HPageBreaks.Count - lngOffset_c
        Do  'Using post test.
            passes = passes + lngOffset_c
            breaksMoved = False
            For i = 1 To lngHBrksUprBnd
                Set p = wstWorksheet.HPageBreaks.Item(i)
                'Move the intended break point up to the first blank section
                lngRow = p.Location.Row - lngOffset_c
                For lngRow = p.Location.Row - lngOffset_c To 1& Step -1&
                    'Checking the LenB is faster than a string check.
                    If LenB(wstWorksheet.Cells(lngRow, lngColSiteIDSecondary_c).Formula) = 0& Then
                        lngRow = lngRow - lngOffset_c
                        If LCase$(wstWorksheet.Cells(lngRow, lngColSiteIDSecondary_c).value) = "site id" Then
                            breaksMoved = True
                            wstWorksheet.HPageBreaks.Add wstWorksheet.Cells(lngRow, lngColSiteIDSecondary_c)
                        End If
                        Exit For
                    End If
                Next
                pctProgress.ProgressText = "Set break point " & (CStr(passes) & "." & CStr(i))
            Next
        Loop While breaksMoved
        LockInterface False
    End Sub

    Private Sub LockInterface(ByVal interfaceOff As Boolean)
        With Excel.Application
            If interfaceOff Then
                .ScreenUpdating = False
                .EnableEvents = False
                .Cursor = xlWait
                .StatusBar = "Working..."
            Else
                .ScreenUpdating = True
                .EnableEvents = True
                .Cursor = xlDefault
                .StatusBar = False
            End If
        End With
    End Sub

回答by JustPlainBill

The easy answer is that you use ActiveCelland Selectand Activate. Excel actually selects the cells as your code is running, making the code run slower (as you've noticed).

简单的答案是您使用ActiveCellandSelect和Activate。Excel 实际上会在您的代码运行时选择单元格，从而使代码运行速度变慢（如您所见）。

I would recommend using a Rangeas a reference and do all the tests "in memory".

我建议使用 aRange作为参考并在“内存中”进行所有测试。

Dim a range for tracking (dim rngCurrentCell as range) and use that instead of the selecting the cells.

将跟踪范围变暗 ( dim rngCurrentCell as range) 并使用它而不是选择单元格。

So, for the first appearance of Selectin your code Range("A3").Select, you would 'Set' it as Set rngCurrentCell = Range("A3"). The same for the Next B4 line.

因此，对于第一次出现Select在您的代码中Range("A3").Select，您会将其“设置”为Set rngCurrentCell = Range("A3"). 下一个 B4 线也是如此。

Then:

然后：

' add breaks after each site
Do While ActiveCell.Row <= wstWorksheet.UsedRange.Rows.Count 

If ActiveCell.FormulaR1C1 = "Site ID" Then
ActiveCell.PageBreak = xlPageBreakManual    
End If    
' Offset the row by one and set our new range
set rngCurrentCell = rngCurrentCell.Offset(1, 0)

pctProgress.ProgressText = "Row " & CStr(ActiveCell.Row) & " of " & CStr(wstWorksheet.UsedRange.Rows.Count)

Loop

And so forth.

等等。

Now to test values use the same syntax as the ActiveCell.

现在测试值使用与ActiveCell.

If you have any questions, let me know.

如果您有任何问题，请告诉我。

回答by Ron McMahon

I took a quick view of your code and my first thought is that this line:

我快速浏览了您的代码，我的第一个想法是这一行：

pctProgress.ProgressText = "Setting Page Break " & CStr(i) & " of " & CStr(shtDeliveryVariance.HPageBreaks.Count)

pctProgress.ProgressText = "设置分页符" & CStr(i) & " of " & CStr(shtDeliveryVariance.HPageBreaks.Count)

may be a cause of some of the delay. The location of this code means that the system has to go and recalculate the .Count value since it comes at the beginning of the loop in your code, but this recalculation does not happen in the original.

可能是某些延迟的原因。此代码的位置意味着系统必须重新计算 .Count 值，因为它出现在代码中的循环开始处，但这种重新计算不会在原始代码中发生。

Other thoughts:

其他想法：

Depending on the spreadsheet size, going out and remeasuring this value may be slowing things down. Why not just manually increment a breaks count tracking variable when you actually perform the addition of a new break instead of having the system go and count it, or get rid of the counting in the loop (since you're not updating the display anyways during this process) and put the counting of page breaks in to its own code segment that runs through the content at the end of the whole formatting process when a final number of page breaks can easily be determined with a single call?

根据电子表格的大小，外出并重新测量此值可能会减慢速度。为什么不在实际执行添加新的中断时手动增加中断计数跟踪变量，而不是让系统去计算它，或者摆脱循环中的计数（因为在此期间您没有更新显示）这个过程）并将分页符的计数放入它自己的代码段中，该代码段在整个格式化过程结束时贯穿整个内容，当最终的分页符可以通过一次调用轻松确定时？