3

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

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

代码遵循上述格式：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_ 为前缀（表示父级）。在我的简短的 4 站点报告和更具挑战性的 15 站点报告中，使用蹩脚的 Now() 粗略计时风格慢了 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 等也已关闭。

4

3 回答 3

13

我在您的代码中的几个地方看到了改进的空间：

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

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

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

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

因此，对于Select您的代码中的第一次出现Range("A3").Select，您可以将其“设置”为Set rngCurrentCell = Range("A3"). Next 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

等等。

现在测试值使用与ActiveCell.

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

于 2009-06-12T20:23:02.697 回答
1

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

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

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

其他想法：

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

于 2009-06-12T17:03:14.783 回答