时间戳

首页 > 解决方案 > 加速工作脚本

vba - 加速工作脚本

问题描述

我有以下脚本，效果很好。唯一的问题是在包含 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

标签： vbaexcel

解决方案

对于这个特殊的任务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

在Code Review上查看此比较：隐藏某些列包含 0 的 Excel 行的脚本

.

利用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

推荐阅读