Pourquoi cette simple macro (pour masquer des lignes) fait-elle perdre à Excel sa réactivité ?

Question

Dans le cadre d'un récent projet de science des transports, on m'a remis une feuille contenant les données de 7094 accidents de voiture. Pour tenter de filtrer uniquement les données pertinentes - dans ce cas, les accidents impliquant des piétons, des morts ou des blessés graves - j'ai essayé d'adapter une macro que j'ai trouvée en ligne.

C'est la première fois que je me frotte à VBA, bien que j'aie une certaine expérience en C et en Java (juste au cas où cela s'avérerait pertinent). Le code est le suivant :

Sub HideRows()
BeginRow = 2
EndRow = 7095
ChkCol = 10

For RowCnt = BeginRow To EndRow
    If Cells(RowCnt, ChkCol).Value > 0 Or Cells(RowCnt, ChkCol + 1).Value > 0 Or Cells(RowCnt, ChkCol + 2).Value > 0 Then
        Rows(RowCnt).EntireRow.Hidden = False
    Else
        Rows(RowCnt).EntireRow.Hidden = True
    End If
        Next RowCnt
End Sub

Le problème est qu'Excel ne répond plus. Je peux voir que la macro exécute la fonction prévue, mais je ne peux pas enregistrer ou reprendre le contrôle du programme à la fin.

J'ai l'impression que le problème (et la solution qui en découle) est très, très simple - espérons-le.

Tout conseil sera grandement apprécié.

Answer 1

Pour accélérer ce code, il suffit d'ajouter Application.ScreenUpdating = False au départ et Application.ScreenUpdating = True à la fin

Sub HideRows()
BeginRow = 2
EndRow = 7095
ChkCol = 10

Application.ScreenUpdating = False
For RowCnt = BeginRow To EndRow
    If Cells(RowCnt, ChkCol).Value > 0 Or Cells(RowCnt, ChkCol + 1).Value > 0 Or Cells(RowCnt, ChkCol + 2).Value > 0 Then
        Rows(RowCnt).EntireRow.Hidden = False
    Else
        Rows(RowCnt).EntireRow.Hidden = True
    End If
Next RowCnt
Application.ScreenUpdating = True
End Sub

Maintenant, vous pouvez également avoir des événements ou des formats conditionnels qui se déclenchent chaque fois que la feuille est mise à jour. Si c'est le cas, incluez également Application.EnableEvents = False au début et les remettre en place à la fin de la boucle.

Et si vous le vouliez vraiment, vous pourriez simplifier vos vérifications booléennes en disant simplement :

If Cells(RowCnt, ChkCol).Value Or Cells(RowCnt, ChkCol + 1).Value Or Cells(RowCnt, ChkCol + 2).Value 0 Then

car 0=Faux en VBA. Cela ne devrait toutefois pas être nécessaire et votre méthode est certainement plus facile à lire.

Answer 2

En plus d'ajouter ScreenUpdating y EnableEvent booléens, vous pouvez également remanier le code pour n'effectuer qu'une seule opération de masquage/démasquage (ou deux dans ce cas), au lieu de le faire à chaque itération de la boucle, ce qui ralentira les choses. Vous pouvez également désactiver les calculs (au cas où cela affecterait les choses).

Option Explicit

    Sub HideRows()

        Dim BeginRow As Integer, EndRow As Integer, ChkCol As Integer

        BeginRow = 2
        EndRow = 7095
        ChkCol = 10

        With Application
            .ScreenUpdating = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With

        Application.Calculation xl

        Dim rHide As Range
        Dim rShow As Range

        For RowCnt = BeginRow To EndRow

            If Cells(RowCnt, ChkCol).Value > 0 Or Cells(RowCnt, ChkCol + 1).Value > 0 Or Cells(RowCnt, ChkCol + 2).Value > 0 Then

                If Not rHide Is Nothing Then
                    Set rHide = Cells(1, RowCnt)
                Else
                    Set rHide = Union(rHide, Cells(1, RowCnt))
                End If

            Else

                If Not rShow Is Nothing Then
                    Set rShow = Cells(1, RowCnt)
                Else
                    Set rShow = rShow(rHide, Cells(1, RowCnt))
                End If

            End If

        Next RowCnt

        'show / hide appropriate ranges
        rHide.EntireRow.Visible = False
        rShow.EntireRow.Visible = True

        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .Calculation = xlCalculationAutomatic
        End With

    End Sub