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个优化：
- 通过保存先前计算的下一次迭代值，计算每行的状态一次，而不是两次 - 收集一个范围对象中的所有空行，并在一个步骤中对其进行格式化。通过寻址＆＃34;可见＆＃34;来格式化范围的其余部分。细胞（通过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秒而不是2.0秒运行，因此加速大致为10：1。

Answer 2

这是我的一个老帖子。 How to speed up multiple replacement using VBA in Word?

记住MINIMIZE DOTS。

阅读帖子，因为它列出了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

Excel VBA隐藏3000行优化

2 个答案: