Excel VBA隐藏3000行优化

Question

我的第一个问题:)

有一张包含3000行的工作表，每次激活该工作表时都需要检查并隐藏它。

通常只有100行是可见的，但是我必须确保它总是足够的行。 （以防万一）。

我有这段代码，效果很好，但是有点慢。 加快速度的技巧会很棒。

Private Sub Worksheet_Activate()
On Error GoTo ExitHandling

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

        'Hide Operations columns if no values
        If Worksheets("BasicData").Range("CheckOperationsZero").Value = "Yes" Then
            Columns("I:J").EntireColumn.Hidden = True
        Else
            Columns("I:J").EntireColumn.Hidden = False
        End If

        'Hide empty rows, dont hide if row belowe is not empty, autofit for better viewing
        ActiveSheet.Rows("17:3017").EntireRow.Hidden = False
        For I = 3016 To 18 Step -1
            If Application.WorksheetFunction.CountIf(Range("B" & I & ":J" & I), vbNullString) >= 9 And Application.WorksheetFunction.CountIf(Range("B" & I + 1 & ":J" & I + 1), vbNullString) >= 9 Then
                Rows(I).RowHeight = 12
                Rows(I).EntireRow.Hidden = True
            Else
                Rows(I).EntireRow.AutoFit
                    If Rows(I).Height < 20 Then
                        Rows(I).RowHeight = 12
                    End If
            End If
        Next I

ExitHandling:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Exit Sub

ErrorHandling:
    MsgBox Err.Description
    Resume ExitHandling

End Sub

Answer 1

以下代码使用2个优化：
-通过保存先前计算的值用于下一次迭代，仅计算一次行状态，而不是两次
-将所有空行收集在一个范围对象中，然后一步设置其格式。 通过寻址“可见”单元格（通过SpecialCells）来格式化范围的其余部分。

Sub Worksheet_Activate()
    ' optimized for performance
    Const entireRange = "B17:J3017"

    Dim rowptr As Range
    Dim emptyrows As Range
    Dim I As Long
    Dim thisRowIsEmpty As Boolean, nextRowIsEmpty As Boolean

    On Error GoTo ExitHandling

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    'Hide Operations columns if no values
    If Worksheets("BasicData").Range("CheckOperationsZero").Value = "Yes" Then
        Columns("I:J").EntireColumn.Hidden = True
    Else
        Columns("I:J").EntireColumn.Hidden = False
    End If

    'Hide empty rows, dont hide if row belowe is not empty, autofit for better viewing
    Rows("17:3017").EntireRow.Hidden = False
    Set emptyrows = Cells(5000, 1)
    Set rowptr = Range("B3017:J3017")
    nextRowIsEmpty = Application.WorksheetFunction.CountIf(rowptr, vbNullString) >= 9
    For I = 3016 To 18 Step -1
        Set rowptr = rowptr.Offset(-1, 0)
        thisRowIsEmpty = Application.WorksheetFunction.CountIf(rowptr, vbNullString) >= 9
        If thisRowIsEmpty And nextRowIsEmpty Then
            Set emptyrows = Application.Union(emptyrows, rowptr)
        End If
        nextRowIsEmpty = thisRowIsEmpty
    Next I

    If Not emptyrows Is Nothing Then
        With emptyrows
            .RowHeight = 12
            .EntireRow.Hidden = True
        End With
    End If
    With Range(entireRange).SpecialCells(xlCellTypeVisible).EntireRow
        .AutoFit
        If .Height < 20 Then
            .RowHeight = 12
        End If
    End With

ExitHandling:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Exit Sub

ErrorHandling:
    MsgBox Err.Description
    Resume ExitHandling
End Sub

在我的笔记本上，此代码将在0.15 s（而不是2.0 s）中运行，因此加速比约为10：1。

Answer 2

这是我的旧职位。 如何在Word中使用VBA加速多次替换？

记住最小化点。

阅读该帖子，因为它列出了4个性能杀手。

最小化点

因此，如果您对性能感兴趣，请最小化点（每个点都是一个查找），尤其是在循环中。

有两种方法。 一种是如果要访问多个对象，则将对象设置为最低对象。

例如（较慢）

set xlapp = CreateObject("Excel.Application")

msgbox xlapp.worksheets(0).name

（速度更快，因为每次使用对象时都会省略一个点）

set xlapp = CreateObject("Excel.Application")

set wsheet = xlapp.worksheets(0)

msgbox wsheet.name

第二种方法是with 。 您只能有一个with同时启动。

这将跳过100次查找。

with wsheet

For x = 1 to 100

  `msgbox .name` 

Next

end with