Question

我有以下脚本，效果很好。唯一的问题是在2000+行的工作表上运行需要花费大量的时间。有人知道加快速度的方法吗？

代码贯穿工作簿并忽略我不想触及的页面。然后，它遍历我想要的任何页面，在C列和D列中查找零，如果找到则隐藏行。

以下是代码：

Sub HideDoubleZeors()

Dim LR As Long, i As Long
Dim c As Variant

For Each ws In Worksheets
    Select Case ws.Name
        Case "Form1", _
                "Form 2", _
                "Form 3"
                'Do nothing on these tabs

        Case Else 'If not one of the above tab names then do this
With ws.Activate
    LR = ws.Range("B" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        With ws.Range("B" & i)
            For Each c In Range("B" & i)
                If c.Value <> "All Forms" _
                    And c.Value <> "Week One All Forms" _
                    And c.Offset(0, 1).Value = 0 _
                    And c.Offset(0, 1).Value <> vbNullString _
                    And c.Offset(0, 2).Value = 0 _
                    And c.Offset(0, 2).Value <> vbNullString _
                Then Rows(c.Row).Hidden = True
                Next c

        End With
       Next i
    End With
    End Select
Next ws
End Sub

Answer 1

对于此特定任务Union非常慢

TestData: 4 Sheets, each with 10,000 rows (x 4); Rows to hide on each: 1,250 (Total 5,000)

Time: 4.641 sec   Union (with Array)
Time: 0.219 sec   AutoFilter

在代码审核：Script to hide Excel rows where certain columns contain 0

上查看此比较

使用AutoFilter

Public Sub HideDoubleZeorsAutoFilter()
    Dim ws As Worksheet, b1 As String, b2 As String, lr As Long, fc As Range, hid As Range

    OptimizeApp True
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Form1", "Form 2", "Form 3"
            Case Else
                ws.Rows(1).Insert Shift:=xlDown
                lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
                Set hid = ws.Cells(lr + 1, "B")
                Set fc = ws.Range("B1:B" & lr)
                With ws.Range("B1:D" & lr)

                    b1 = "<>All Forms"
                    b2 = "<>Week One All Forms"

                   .AutoFilter Field:=1, Criteria1:=b1, Operator:=xlAnd, Criteria2:=b2
                   .AutoFilter Field:=2, Criteria1:="=0"
                   .AutoFilter Field:=3, Criteria1:="=0"

                    If fc.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                        Set hid = Union(hid, fc.SpecialCells(xlCellTypeVisible))
                       .AutoFilter
                        hid.EntireRow.Hidden = True
                    End If
                End With
                ws.Rows(1).Delete Shift:=xlUp
                ws.Activate
                ActiveWindow.ScrollRow = 1
        End Select
    Next ws
    Worksheets(1).Activate
    OptimizeApp False
End Sub

Private Sub OptimizeApp(ByVal speedUp As Boolean)
    Application.Calculation = IIf(speedUp, xlCalculationManual, xlCalculationAutomatic)
    Application.ScreenUpdating = Not speedUp
    Application.DisplayAlerts = Not speedUp
    Application.EnableEvents = Not speedUp
End Sub

Answer 2

使用union函数收集该行，而不是逐行隐藏行。之后，立即隐藏它们。

Sub HideDoubleZeors()

Dim LR As Long, i As Long
Dim c As Range
Dim rngU As Range
For Each ws In Worksheets
    Select Case ws.Name
        Case "Form1", _
                "Form 2", _
                "Form 3"
                'Do nothing on these tabs

        Case Else 'If not one of the above tab names then do this
            With ws
                Set rngU = Nothing
                LR = .Range("B" & Rows.Count).End(xlUp).Row
                'For i = 1 To LR
                    'With ws.Range("B" & i)
                        For Each c In .Range("B1", "B" & LR)
                            If c.Value <> "All Forms" _
                                And c.Value <> "Week One All Forms" _
                                And c.Offset(0, 1).Value = 0 _
                                And c.Offset(0, 1).Value <> vbNullString _
                                And c.Offset(0, 2).Value = 0 _
                                And c.Offset(0, 2).Value <> vbNullString _
                            Then
                                If rngU Is Nothing Then
                                    Set rngU = c
                                Else
                                    Set rngU = Union(rngU, c)
                                End If
                            End If
                        Next c
                        If rngU Is Nothing Then
                        Else
                            rngU.EntireRow.Hidden = True
                        End If
            End With
    End Select
Next ws
End Sub

加快工作脚本

2 个答案: