Garder uniquement les lignes avec texte de couleur rouge

IZELLOUP

XLDnaute Junior
:) Bonjour le forum.

Je recherche une solution par macro de préférence afin de conserver uniquement les lignes de ma feuille dont le texte est en rouge. La feuille d'origine possède plus de 6000 lignes.
Merci beaucoup.
Izelloup.:eek:
 

Pièces jointes

  • Classeur1.xls
    217.5 KB · Affichages: 88
  • Classeur1.xls
    217.5 KB · Affichages: 110
  • Classeur1.xls
    217.5 KB · Affichages: 96

DoubleZero

XLDnaute Barbatruc
Re : Garder uniquement les lignes avec texte de couleur rouge

Bonjour, IZELLOUP, le Forum,

Une suggestion :

Code:
Sub Lignes_non_rouges_supprimer()
Application.ScreenUpdating = False
Dim i As Long
    For i = Range("a65536").End(xlUp).Row To 2 Step -1
        If Range("a" & i).Font.ColorIndex <> 3 Then Rows(i).Delete
    Next
Application.ScreenUpdating = True
End Sub

A bientôt :)
 

Victor21

XLDnaute Barbatruc
Re : Garder uniquement les lignes avec texte de couleur rouge

Bonsoir, IZELLOUP

Question préalable : pourquoi certaines lignes sont-elles rouges ?
En complément :
- Y a-t'il un critère logique
- Si oui, lequel ?
- Sinon qui met ces lignes en rouge ?
- Si c'est vous, pouvez-vous, en alternative, mettre une annotation en colonne I ?

Edit : Bonsoir, OO ;)
 
Dernière édition:

IZELLOUP

XLDnaute Junior
Re : Garder uniquement les lignes avec texte de couleur rouge

Bonsoir Patrick,

Désolé, je testais la solution de Doublezéro. Pour être plus précis. Ces lignes sont obtenues par extraction grâce à une requête html.
Cordialement.
Stéphane.
 

DoubleZero

XLDnaute Barbatruc
Re : Garder uniquement les lignes avec texte de couleur rouge

Re-bonjour, bonjour, Victor21 :D,

Tester ceci :

Code:
Sub Lignes_non_rouges_supprimer()
Dim i As Long
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
        For i = Range("a65536").End(xlUp).Row To 2 Step -1
            If Range("a" & i).Font.ColorIndex <> 3 Then Rows(i).Delete
        Next
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

A bientôt :)
 

job75

XLDnaute Barbatruc
Re : Garder uniquement les lignes avec texte de couleur rouge

Bonsoir tout le monde,

Ceci est forcément plus rapide car la suppression se fait en bloc :

Code:
Sub Lignes_non_rouges_supprimer()
Dim cel As Range, sup As Range
Application.ScreenUpdating = False 'peut-être inutile
For Each cel In Range("A2", [A65536].End(xlUp)) 'A2 si titres en ligne 1
  If cel.Font.ColorIndex <> 3 Then Set sup = Union(IIf(sup Is Nothing, cel, sup), cel)
Next
If Not sup Is Nothing Then sup.EntireRow.Delete
End Sub
A+
 

IZELLOUP

XLDnaute Junior
Re : Garder uniquement les lignes avec texte de couleur rouge

Bonsoir Job75,

Effectivement, c'est beaucoup plus rapide (environ 4mn pour mes 6000 lignes). Cela me convient parfaitement. Grand merci à toi et à DoubleZero pour vos propositions.
Bonne soirée.
Cordialement.
Stéphane.
 

Jacou

XLDnaute Impliqué
Re : Garder uniquement les lignes avec texte de couleur rouge

Bonsoir à tous,

sans VBA, il y a aussi le filtre par couleur :
on met en place un filtre,
on sélectionne une couleur qui n'est pas rouge,
puis on sélectionne toutes les lignes filtrées et on appuie sur sup.

s'il n'y a pas 36 couleurs différentes c'est assez rapide!
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Garder uniquement les lignes avec texte de couleur rouge

Bonjour,

Voir PJ

Cette méthode est la plus rapide(les lignes à supprimer sont regroupées à la fin).

0,1 s pour 10.000 lignes

Code:
Sub supLignesRapide()
  Application.ScreenUpdating = False
  a = Range("A1:A" & [A65000].End(xlUp).Row)
  For i = LBound(a) To UBound(a)
    If Cells(i, 1).Font.ColorIndex = 3 Then a(i, 1) = 0 Else a(i, 1) = "sup"
  Next i
  Columns("b:b").Insert Shift:=xlToRight
  [B1].Resize(UBound(a)) = a
  [A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess
  On Error Resume Next
  Range("B2:B65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  Columns("b:b").Delete Shift:=xlToLeft
End Sub

JB
 

Pièces jointes

  • Copie de Classeur1.xls
    231 KB · Affichages: 90
  • Copie de Classeur1.xls
    231 KB · Affichages: 85
  • Copie de Classeur1.xls
    231 KB · Affichages: 88
Dernière édition:

job75

XLDnaute Barbatruc
Re : Garder uniquement les lignes avec texte de couleur rouge

Bonjour JB, le forum,

Placer les lignes à supprimer en bas du tableau est en effet essentiel, merci de l'avoir rappelé.

Nota : j'ai recopié le tableau sur 10000 lignes, sur portable avec Windows 7 et Excel 2010 => 3,7 secondes.

A+
 

IZELLOUP

XLDnaute Junior
Re : Garder uniquement les lignes avec texte de couleur rouge

Bonjour BOISGONTIER, le forum,

Bravo, encore plus rapide ! Moins d'une minute chez moi avec une configuration PC basée sur un Core2 duo E6750. Cela me convient largement. Merci à tous.
A bientôt.
Stéphane.
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 920
Membres
101 840
dernier inscrit
SamynoT