XL 2016 Masquer et afficher lignes

[halecs93]

Bonjour,

J'ai tenté une macro qui me permet de masquer des lignes où n'apparaissent pas de cellules colorées de ma feuille.

Elle fonctionne mais elle est très longue dans son déroulement.

Une autre approche permettrait de l'accélérer ?

Sub MasquerLignesSansCouleur()
    Dim ws As Worksheet
    Dim cell As Range
    Dim row As Long
    Dim firstRowWithColor As Long
    Dim lastRowWithColor As Long
    
    ' Utiliser la feuille active
    Set ws = ActiveSheet
    
    ' Initialiser la première et la dernière ligne contenant une cellule colorée à 0
    firstRowWithColor = 0
    lastRowWithColor = 0
    
    ' Parcourir les lignes de 5 à 61
    For row = 5 To 61
        ' Parcourir les cellules de la plage B:P de la ligne actuelle
        For Each cell In ws.Range("B" & row & ":P" & row)
            ' Vérifier si la cellule est colorée
            If cell.Interior.ColorIndex <> xlNone Then
                ' Mettre à jour la première ligne contenant une cellule colorée
                If firstRowWithColor = 0 Then
                    firstRowWithColor = row
                End If
                ' Mettre à jour la dernière ligne contenant une cellule colorée
                lastRowWithColor = row
                Exit For ' Sortir de la boucle si une cellule colorée est trouvée
            End If
        Next cell
    Next row
    
    ' Si une cellule colorée a été trouvée
    If lastRowWithColor > 0 Then
        ' Masquer les lignes situées en dessous de la dernière ligne colorée jusqu'à la ligne 61
        For row = lastRowWithColor + 1 To 61
            ws.Rows(row).EntireRow.Hidden = True
        Next row
    End If
    
    ' Si une cellule colorée a été trouvée
    If firstRowWithColor > 0 Then
        ' Masquer les lignes situées au-dessus de la première ligne colorée jusqu'à la ligne 5
        For row = 5 To firstRowWithColor - 1
            ws.Rows(row).EntireRow.Hidden = True
        Next row
    End If
End Sub

Merci

 

[gbinforme]

Bonjour,

Pour masquer les lignes tu peux éviter les boucles :

    ' Si une cellule colorée a été trouvée
    If lastRowWithColor > 0 Then
        ' Masquer les lignes situées en dessous de la dernière ligne colorée jusqu'à la ligne 61
        ws.Rows(lastRowWithColor + 1).Resize(61 - lastRowWithColor).Hidden = True
    End If
    
    ' Si une cellule colorée a été trouvée
    If firstRowWithColor > 0 Then
        ' Masquer les lignes situées au-dessus de la première ligne colorée jusqu'à la ligne 5
        ws.Rows(5).Resize(firstRowWithColor - 5).Hidden = True
    End If

 

[halecs93]

Bonjour,

Pour masquer les lignes tu peux éviter les boucles :

    ' Si une cellule colorée a été trouvée
    If lastRowWithColor > 0 Then
        ' Masquer les lignes situées en dessous de la dernière ligne colorée jusqu'à la ligne 61
        ws.Rows(lastRowWithColor + 1).Resize(61 - lastRowWithColor).Hidden = True
    End If
   
    ' Si une cellule colorée a été trouvée
    If firstRowWithColor > 0 Then
        ' Masquer les lignes situées au-dessus de la première ligne colorée jusqu'à la ligne 5
        ws.Rows(5).Resize(firstRowWithColor - 5).Hidden = True
    End If

Bonjour,

J'ai testé, mais cela n'a pas du tout fonctionné/ J'ai réussi à accélérer l’exécution de la macro avec le code suivant :

Sub MasquerLignesSansCouleur_5()
    Dim ws As Worksheet
    Dim cell As Range
    Dim firstRowWithColor As Long
    Dim lastRowWithColor As Long
    Dim row As Long
    
    ' Utiliser la feuille active
    Set ws = ActiveSheet
    
    ' Réinitialiser les variables
    firstRowWithColor = 0
    lastRowWithColor = 0
    
    ' Parcourir les lignes de 5 à 61
    For row = 5 To 61
        ' Vérifier si la ligne contient une cellule colorée
        For Each cell In ws.Range("B" & row & ":P" & row)
            If cell.Interior.ColorIndex <> xlNone Then ' Comparer avec "sans couleur"
                ' Mettre à jour la première ligne contenant une cellule colorée
                If firstRowWithColor = 0 Then
                    firstRowWithColor = row
                End If
                ' Mettre à jour la dernière ligne contenant une cellule colorée
                lastRowWithColor = row
                Exit For ' Sortir de la boucle si une cellule colorée est trouvée
            End If
        Next cell
    Next row
    
    ' Masquer les lignes situées en dessous de la dernière ligne colorée jusqu'à la ligne 61
    If lastRowWithColor > 0 Then
        If lastRowWithColor + 2 < 61 Then
            ws.Rows(lastRowWithColor + 3 & ":61").EntireRow.Hidden = True
        End If
    End If
    
    ' Masquer les lignes situées au-dessus de la première ligne colorée jusqu'à la ligne 5
    If firstRowWithColor > 0 Then
        If firstRowWithColor > 5 Then
            ws.Rows("5:" & firstRowWithColor - 2).EntireRow.Hidden = True
        End If
    End If
End Sub

 

[gbinforme]

re
C'est parfait d'avoir réussi.