主页 / coding / 问题 / 79335346
Accepted
Ramadan Moussa
Asked: 2025-01-07 16:37:29 +0800 CST

宏需要很长时间才能应用到桌面上

  • 772

我有一张工作表，其中的表格有 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
excel

1 个回答

  1. Best Answer

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

    您还可以添加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
    • 3

相关问题