Suppression de ligne selon critère

[Nissama]

Bonjour,

Cela fait 3 jours que je planche sur mon problème. J'ai beau faire des regroupement de code ou de les modifier, je n'y arrive pas. PS : je viens de découvrir le codage VBA.
J'aimerai un peu d'aide pour trouver une solution.
Voici,
Je souhaite supprimer ou effacer toutes les lignes ou l'on trouve dans la colonne F un remplissage vert, en sachant que les colonnes de A à F vont jusqu'à 1048576 lignes.

Meri d'avance.

 

[Theze]

Re : Suppression de ligne selon critère

Bonjour,

Teste ceci :

Sub Test()

    Dim Plage As Range
    Dim Couleur As Integer
    Dim I As Long
    
    'adapter l'index de la couleur (voir la proc ci-dessous)...
    Couleur = 14
    
    'définie la plage en colonne F de la feuille "Feuil1", adapter...
    With Worksheets("Feuil1")
     
        Set Plage = .Range(.Cells(1, 6), .Cells(.Rows.Count, 6).End(xlUp))
    
    End With
    
    'boucle pour la suppression
    For I = Plage.Count To 1 Step -1
        
        If Plage(I).Interior.ColorIndex = Couleur Then Plage(I).EntireRow.Delete
    
    Next I
    
End Sub

Sub QuelleCouleur()
    
    'colorer A1 de la couleur recherchée et lancer cette proc
    'pour connaître l'index de la couleur
    MsgBox Range("A1").Interior.ColorIndex
    
End Sub

Hervé.

 

[Nissama]

Re : Suppression de ligne selon critère

Merci, j'essaye de suite.

Nico

 

[Nissama]

Re : Suppression de ligne selon critère

re bonjour

Cela fait maintenant 2 heures que la macro tourne, et toujours rien.
normal ?

 

[Nissama]

Re : Suppression de ligne selon critère

je pense que ton code est bien mais si à chaque ligne, excel doit tout remonter d'une ligne, je crois que je serais mort avant qu'il ne finisse le calcule.
Une astuce pour éviter cela?

On m'a parlé de trouver la ligne et de la copier sur une autre feuille, cela prendrai moins de temps.

 

[Theze]

Re : Suppression de ligne selon critère

Bonjour,

Alors essai en supprimant juste les valeurs dans les lignes en non les lignes elles mêmes mais de toute façon avec 1048576 lignes ça prend du temps :

Sub Test()

    Dim Plage As Range
    Dim Couleur As Integer
    Dim I As Long
    
    'adapter l'index de la couleur (voir la proc ci-dessous)...
    Couleur = 14
    
    'définie la plage en colonne F de la feuille "Feuil1", adapter...
    With Worksheets("Feuil1")
     
        Set Plage = .Range(.Cells(1, 6), .Cells(.Rows.Count, 6).End(xlUp))
    
    End With
    
    'boucle pour la suppression
    For I = 1 To Plage.Count
    
        If Plage(I).Interior.ColorIndex = Couleur Then Plage(I).EntireRow.Value = ""
    
    Next I
    
End Sub

Hervé.

 

[job75]

Re : Suppression de ligne selon critère

Bonjour Nissama, Theze,

Mettez tout le code suivant dans un module standard et exécutez-le :

Sub SupprimeCouleur()
Dim codecouleur, f$
codecouleur = 4 'à adapter
f = "=1/TestCouleur(RC[-1]," & codecouleur & ")"
[G:G].Insert
[G:G] = f
[G:G] = [G:G].Value 'supprime les formules
[A:G].Sort [G1], xlDescending, Header:=xlYes 'il y a des en-têtes
[G:G].SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
[G:G].Delete
End Sub

Function TestCouleur(cel As Range, codecouleur) As Boolean
TestCouleur = cel.Interior.ColorIndex = codecouleur
End Function

J'ai testé sur un tableau A1:F1048576 entièrement rempli de "X" et une ligne de titre.

J'avais coloré une cellule sur deux en colonne F par cette macro :

Sub CouleurVerte()
[F3].Interior.ColorIndex = 4
[F2:F3].Copy
[F4:F1048575].PasteSpecial xlPasteFormats
End Sub

La suppression des lignes vertes s'est effectuée en 45 secondes sur Win 7 - Excel 2010.

C'est très acceptable sur un fichier pesant 24 Mo...

A+

 

[job75]

Re : Suppression de ligne selon critère

Re,

Avec Application.ScreenUpdating = False en début de macro, l'exécution se fait en 36 secondes.

Edit : détail :

- entrée des formules 27,1 s
- copie valeurs 3,7 s
- tri décroissant 3,7 s
- suppression 1,1 s

A+

 

[job75]

Re : Suppression de ligne selon critère

Re,

En fait c'est le "simple" effacement des lignes qui pose problème.

J'ai tenté avec :

Sub SupprimeCouleur()
Dim codecouleur, f$
codecouleur = 4 'à adapter
f = "=1/TestCouleur(RC[-1]," & codecouleur & ")"
Application.ScreenUpdating = False
[G:G].Insert
[G:G] = f
[G:G].SpecialCells(xlCellTypeFormulas, 1).EntireRow.Clear
[G:G].Delete
End Sub

Je me suis lassé et suis sorti par le Gestionnaire des tâches.

A+

 

[job75]

Re : Suppression de ligne selon critère

Re,

Pour l'effacement voici la bonne méthode.

Il faut 2 colonnes auxiliaires et 2 tris :

Sub EffaceCouleur()
Dim codecouleur, f$
codecouleur = 4 'à adapter
f = "=1/TestCouleur(RC[-1]," & codecouleur & ")"
Application.ScreenUpdating = False
[G:H].Insert '2 colonnes auxiliaires
[G:G] = f
[G:G] = [G:G].Value 'supprime les formules
[H1] = 1
[H:H].DataSeries 'numérotation
[A:H].Sort [G1] '1er tri
Intersect([A:G], [G:G].SpecialCells(xlCellTypeConstants, 1).EntireRow).Clear
[A:H].Sort [H1], xlAscending '2ème tri, retour à l'ordre initial
[G:H].Delete
End Sub

Function TestCouleur(cel As Range, codecouleur) As Boolean
TestCouleur = cel.Interior.ColorIndex = codecouleur
End Function

Sur mon fichier la macro s'exécute en 42 secondes.

A+