XL 2013 supprimer les lignes coloré et les lignes vides

[merabet amine]

Bonjour,
dans ma quette je voudrai créer un macro qui me permmetra de supprimer les ligne vide et les lignes coloré.
merci d'avance

 

[Robert]

Bonjour Merabet Amine, bonjour le forum,

Peut-être comme ça (onglet a adapter) :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim PLU As Range 'déclare la variable PLU (PLage Utilisée)
Dim PL As Long 'déclare la variable PL (Première Ligne)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim LI As Long 'déclare la variable LI (LIgne)

Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
Set PLU = O.UsedRange 'définit la plage utilisée PLU
PL = PLU.Cells(1, 1).Row 'définit la première ligne PL de la plage utilisée PLU
DL = PLU.SpecialCells(xlCellTypeLastCell).Row 'définit la dernière ligne DL de la plage utilisée PLU
For LI = DL To PL Step -1 'boucle inversée de la dernière ligne DL à la première PL
    'si la ligne contient autant de cellules vide que la plage utilisée PLU contient de colonnes, efface la ligne
    If Application.WorksheetFunction.CountBlank(Application.Intersect(O.UsedRange, O.Rows(LI))) = PLU.Columns.Count Then Rows(LI).Delete
    'si la ligne de la plage PLU est entièrement colorée, efface la ligne
    If Application.Intersect(O.UsedRange, O.Rows(LI)).Interior.ColorIndex <> xlNone Then Rows(LI).Delete
Next LI 'prochaine ligne de la boucle
End Sub

 

[merabet amine]

merci beacoup

 

[job75]

Bonjour merabet amine, Robert,

merci beacoup

Plutôt laconique comme réponse, vous avez testé ?

S'il y a beaucoup de lignes à supprimer la méthode de Robert prendra beaucoup de temps.

Avec un tableau VBA c'est bien plus rapide :

Sub Macro2()
Dim tablo, i&, n&, j%
With ActiveSheet.UsedRange
    tablo = .Formula 'matrice, plus rapide
    ncol = UBound(tablo, 2)
    For i = 1 To UBound(tablo)
        If Application.CountA(.Rows(i)) And .Rows(i).Interior.ColorIndex <> xlNone Then
            n = n + 1
            For j = 1 To ncol: tablo(n, j) = tablo(i, j): Next
        End If
    Next
    .Formula = "" 'RAZ
    .Interior.ColorIndex = xlNone 'RAZ
    If n Then
        .Resize(n).Interior.ColorIndex = xlNone 'RAZ
        .Resize(n).Formula = tablo
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1).Delete xlUp 'RAZ en dessous
End With
With ActiveSheet.UsedRange: End With 'actualise la barre de défilement verticale
End Sub

J'ai testé sur (seulement) 15 000 lignes dont 10 000 sont supprimées :

- macro de Robert => 53 secondes

- cette macro => 1,1 seconde chez moi sur Win 10 - Excel 2013.

A+