宏需要很长时间才能应用在桌子上

Question

我有一个包含超过 400 行的表格的工作表，并且如果单元格中的日期早于 TODAY() 90 天，我有一个代码可以根据单元格值隐藏一些行。它工作得很好，但不幸的是，它需要很长时间才能应用到所有桌子上，我可以看到它一排又一排地进行遍历。有什么建议请。

这是我的代码

Sub hideolderdates()

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Database")

wsLR = ws.Cells(Rows.Count, 9).End(xlUp).Row

For x = 5 To wsLR
    'analyze date, see if its 3 weeks or older
    If ws.Cells(x, 9) <= Date - 90 Then
     'hide
     ws.Range("a" & x).EntireRow.Hidden = True
           
    End If
Next x

End Sub

Answer 1

您可以将所有日期放入一个数组中，因为这比在循环的每次传递中引用工作表更快。

您还可以添加

Application.ScreenUpdating = False

和

Application.EnableEvents = False

，如@Shrotter 在他的评论中指出的那样 - 请记住在程序结束时将它们恢复为 True。

单元格中只有 881 个日期，执行时间约为 0.02 秒。

''''''''''''''''''''''''''''''''''''''''''''''''''
'This section will time how long the procedure takes to run.
'Remove if you want.

Private StartTime As Double ' - must go at very top of module.

Public Sub RunTimeStart()
    StartTime = Timer
End Sub

Public Sub RunTimeEnd()
    MsgBox "Executed in " & Round(Timer - StartTime, 2) & " seconds.", vbInformation + vbOKOnly
End Sub

'End of timer section
'''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub HideOlderDates()

    RunTimeStart 'Remove to remove timer.

    With ThisWorkbook.Worksheets("Database")
    
        'Last row number.
        Dim wsLR As Long
        wsLR = .Cells(.Rows.Count, 9).End(xlUp).Row
        
        'Get reference to cells containing dates and place values into an array.
        Dim DateCol As Variant
        DateCol = .Range(.Cells(5, 9), .Cells(wsLR, 9))
        
        'Look at each date within the array.
        'If it's older than 90 days then add to the RngToHide range.
        '+4 is added to the value of x so it references the correct row on the sheet.
        Dim RngToHide As Range
        Dim x As Long
        For x = 1 To UBound(DateCol)
            If IsDate(DateCol(x, 1)) Then
                If CDate(DateCol(x, 1)) <= Date - 90 Then
                    If RngToHide Is Nothing Then
                        Set RngToHide = .Rows(x + 4)
                    Else
                        Set RngToHide = Union(RngToHide, .Rows(x + 4))
                    End If
                End If
            End If
        Next x
        
        'Hide the rows in RngToHide.
        RngToHide.EntireRow.Hidden = True
        
    End With
    
    RunTimeEnd 'Remove to remove timer.

End Sub