Excel分页符通过VBA
作为报告生成器检修的一部分，我看到了我认为是低效的代码。 生成主报表后，将运行这部分代码，以将分页符设置为逻辑位置。 标准是这样的：
- 每个网站开始一个新的页面。
- 小组不允许打破页面。
代码遵循上面的格式：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 看到改进的余地我设置了修改这个。 作为新的要求之一，人们希望报告是在打印之前手动删除页面。 所以我在另一个页面上添加了checkbox，并复制了选中的项目。 为了缓解我使用命名的范围。 我使用这些命名的范围来满足第一个要求：
' 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_（父母）作为前缀。 使用蹩脚的现在（）粗略时间的风格，这是我的短4现场报告和更具挑战性的15现场报告慢1秒。 这些分别有606和1600行。
1秒不是那么糟糕。 让我们看看下一个标准。 每个逻辑组由一个空行分割，所以最简单的方法是find下一个分页符，直到find下一个空行并插入新的分隔符。 冲洗并重复。
那么为什么原稿要经过多次？ 我们也可以改进（环路外的锅炉板是一样的）。
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
一通也更优雅。 但是更快多less呢？ 小testing比原来的45秒需要54秒，在较大的testing中，我的代码在153到130秒再次变慢。 这也是3次平均。
所以我的问题是： 为什么我的新代码比原来慢得多，尽pipe我的代码看起来更快 ， 我该怎么做才能加快代码的速度 ？
注意 ：Screen.Updating等已经是计算等。
我在代码中的几个地方看到了改进的空间：
- 不要访问缓慢执行的属性，比如usedrange.rows.count不止一次（特别是在循环中），除非你认为它们可能有变化。 而是将它们存储在一个variables中。
- 不要做文本比较，如果你可以避免它（例如：.Value =“”），而是使用LenB函数来检查空白，它将执行得更快，因为它只是读取string标题的长度，而不是启动到一个逐字节string比较。 （你可以享受这个阅读。）
- 不要使用“激活”或“select”来移动ActiveCell，只需直接访问该范围。
- 循环时，构build您的循环必须执行尽可能less的testing。 如果循环必须总是执行一次，那么你想要一个后测循环。
- 确保你的Excel界面被locking，如运行事件和屏幕更新等，可以减慢你的代码很多。 （尤其是事件）
- 最后，我注意到你对“网站ID”的情况做了一些假设，除非没有其他可能的方式，否则最好做一个不区分大小写的比较。 如果你知道这样的事实，那么你可以删除我添加的LCase $的调用。
我重构了原始代码给你一些这些想法的例子。 不知道你的数据布局，很难确定这个代码是否是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
简单的答案是你使用ActiveCell和Select和Activate 。 当你的代码正在运行时，Excel实际上会select这些单元格，使代码运行速度变慢（正如你所注意的那样）。
我会build议使用一个Range作为参考，并做所有的testing“内存”。
调dim rngCurrentCell as range跟踪范围（ dim rngCurrentCell as range ）并使用该dim rngCurrentCell as range代替select单元格。
因此，对于代码Range("A3").Select中Select的第一个外观， Select ，将其Set rngCurrentCell = Range("A3")为Set rngCurrentCell = Range("A3") 。 下一个B4线也一样。
然后：
' 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
等等。
现在testing值使用与ActiveCell相同的语法。
如果您有任何问题，请告诉我。
我快速查看了你的代码，我首先想到的就是这一行：
pctProgress.ProgressText =“设置分页符”＆CStr（i）＆“of”＆CStr（shtDeliveryVariance.HPageBreaks.Count）
可能是一些延误的原因。 这段代码的位置意味着系统必须重新计算.Count值，因为它是在代码的循环开始处进行的，但是这种重新计算在原始文件中不会发生。
其他想法：
根据电子表格的大小，出去重新衡量这个值可能会减慢速度。 为什么不是在实际执行新的中断时手动增加中断计数跟踪variables，而不是让系统去计算它，或者去掉循环中的计数（因为无论如何您都没有更新显示这个过程），并把分页计数放到它自己的代码段中，当整个格式化过程结束时通过内容运行，当一次调用就可以很容易地确定最后的分页符数时？