加快工作脚本的速度

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

请参阅代码审查中的此比较：用于隐藏某些列包含 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

Answer 2

不要逐个隐藏行，而是使用联合函数来收集该行。之后，一次将它们全部隐藏起来。

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