Início / coding / Perguntas / 79335346
Accepted
Ramadan Moussa
Asked: 2025-01-07 16:37:29 +0800 CST

A Macro demora muito tempo para ser aplicada em uma tabela

  • 772

Tenho uma planilha com uma tabela com mais de 400 linhas e um código para ocultar algumas linhas com base em um valor de célula se a data na célula for anterior a TODAY() com 90 dias. Funciona bem, mas infelizmente demora muito para aplicar em todas as tabelas e vejo que ele percorre as linhas uma após uma, o que é uma tradução. Alguma sugestão, por favor?

aqui está meu código

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 respostas

  1. Best Answer

    Você pode colocar todas as suas datas em uma matriz, pois isso será mais rápido do que referenciar a planilha em cada passagem do seu loop.

    Você também pode adicionar Application.ScreenUpdating = Falseand Application.EnableEvents = Falsecomo @Shrotter indica em seu comentário - lembre-se de retornar para True no final do procedimento.

    Com apenas 881 datas nas células, levou cerca de 0,02 segundos para ser executado.

    ''''''''''''''''''''''''''''''''''''''''''''''''''
'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

relate perguntas