[Excel]Macro suppr ligne si le fond est rouge

lml-mike Messages postés 449 Date d'inscription   Statut Contributeur Dernière intervention   -  
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,

J'ai une liste de 4000 produits sur une fiche excel, ou chaque année on fait une mise à jour, en identifiant ce que devient le produit en colorant la case (et en laissant le texte noir).

Est-il possible de créer une macro qui balaye entièrement le tableau, et supprime la ligne a chaque fois qu'elle voit un produit coloré en rouge ?

Merci pour votre aide.

Mike.

4 réponses

  1. ccm81 Messages postés 11033 Statut Membre 2 434
     
    bonjour
    une macro qui peut faire l'affaire
    - modifier les valeurs des constantes
    - si la couleur rouge peut etre dans plusieurs colonnes, il faudra boucler sur les colonnes du tableau

    Const PremLigne = 1
    Const DerLigne = 8
    Const ColTestee = 1
      For nuli = PremLigne To DerLigne
        If Cells(nuli, ColTestee).Interior.ColorIndex = 3 Then
          Rows(nuli).Delete
        End If
      Next nuli


    bonne suite
    1
  2. cousinhub29 Messages postés 1113 Date d'inscription   Statut Membre Dernière intervention   383
     
    Bonjour,

    @ CCM81, il est d'usage, voire conseillé, lorsque l'on veut supprimer des lignes, de commencer de la dernière vers la première, en utilisant un Step -1

    @ lml - Mike, tout dépend, d'une part, de ta version Excel, et ensuite, si la couleur émane d'une Mise en Forme Conditionnelle, ou d'une mise en forme "Manuelle"...

    @ te relire
    0
    1. ccm81 Messages postés 11033 Statut Membre 2 434
       
      donc

      1. modifier la boucle
      For nuli = DerLigne to PremLigne step -1

      2. si la couleur vient d'une MFC il faudra remplacer le test (if ...) par celui qui conditionne la couleur rouge
      3. il sera prudent de vérifier le code couleur du rouge de la version

      merci cosinhub de me rappeler les (bons) usages
      0
  3. lml-mike Messages postés 449 Date d'inscription   Statut Contributeur Dernière intervention   123
     
    Bonjour et merci pour votre attention et votre aide :-)

    En fait je pensais plus à faire :

    ligne = Range("b1").Row
    col = Range("b1").Column

    While Cells(ligne, col).Value < "B5000"

    If Cells(ligne, col).Interior.ColorIndex = 3 Then
    Rows(ligne).Delete
    End If

    Wend

    Je vais tester ça :-)

    Merci pour la fonction interior.colorindex :-)
    0
    1. ccm81 Messages postés 11033 Statut Membre 2 434
       
      re

      je ne comprends pas bien
      1- Range("b1").row
      est ce que b1 correspond a la cellule B1 auquel cas ligne = 1 suffit (idem pour la colonne)
      2- la boucle while Cells(ligne,colonne).Value < "B5000" ... wend
      elle est controlée par les valeurs de ligne et colonne, variables qui ne vont pas evoluer si la ligne n'est pas supprimée
      "B5000" : est ce une valeur contenue dans une cellule ou la référence à une cellule?

      bonne suite
      0
    2. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      Bonjour tout le monde

      ci dessous macro peut être plus rapide compte tenu du grand nombre de lignes (4000)

      Option Explicit
      Option Base 1
      Sub effacer_rouge()
      Dim Plage As Range
      Dim tablo_in, tablo_out
      Dim derlig As Integer, cols As Byte
      Dim cptr_in As Integer, cptr_out As Integer, cptr_col As Byte
      
      Set Plage = Range("B1").CurrentRegion
      tablo_in = Plage
      derlig = Plage.Rows.Count
      cols = Plage.Columns.Count
      
      ReDim tablo_out(derlig, cols)
      cptr_out = 1
      For cptr_in = 1 To derlig
          If Cells(cptr_in, 2).Interior.ColorIndex <> 3 Then
              For cptr_col = 1 To cols
                  tablo_out(cptr_out, cptr_col) = tablo_in(cptr_in, cptr_col)
              Next
              cptr_out = cptr_out + 1
          End If
      Next
      
      Application.ScreenUpdating = False
      Plage.Clear
      Range(Cells(1, 2), Cells(derlig, cols + 1)) = tablo_out
      
      End Sub


      je fais des mesures de durée et reviens... :-)
      0
    3. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      Re
      durée pour 6000 lignes: environ 0,6 secondes
      (plus il y a de "rouges" plus c'est rapide)

      démo durée:
      http://www.cijoint.fr/cjlink.php?file=cj201011/cij4zmNYHm.xls
      0
  4. lml-mike Messages postés 449 Date d'inscription   Statut Contributeur Dernière intervention   123
     
    Bonjour, et merci pour ces programmes !

    J'aurais dû préciser qu'il y avait des espaces dans mon tableau, parce que je tombe avec le programme de michel en remplaçant B1 par D10 sur ça :

    Avant :
    http://www.noelshack.com/

    Après :
    http://www.noelshack.com/

    ça marche pas trop :D

    En fait il me faudrait :

    En partant de B1 (ou b10 peu importe)
    A chaque ligne passée, si dans D"la ligne" la couleur est rouge,
    Je supprime la ligne entière sinon
    Je passe à la ligne suivante.

    C'est tout :D

    Merci encore pour votre attention !
    0
    1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      Bonjour
      ..."J'aurais dû préciser qu'il y avait... "

      Il faut bien te rendre compte que ce que tu demandes n'est pas forcément facile et que personne ne veut ou ne peut passer parfois plusieurs heures à essayer de résoudre un problème bénévolement pour se voir dire après coup "En fait il me faudrait..."

      Désolé
      0
    2. lml-mike Messages postés 449 Date d'inscription   Statut Contributeur Dernière intervention   123
       
      Désolé de t'avoir blessé, je voulais pas que tu croies que je demandais des gens à ma disposition pour mon problèmes. Ma phrase était maladroite :/
      0
    3. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      Je ne suis pas blessé, mais déçu et lassé d'essayer de donner des coups de mains bénévoles; il est certain que si tu avais donné ce problème contre rémunérations à un entrepreneur, tu aurais fait beaucoup plus fais attention à fournir des renseignements précis et complets car les flous dans le "cahier des charges" coutent très chers.
      Ce n'est pas ta phrase qui est maladroite, c'est ta démarche globale.

      Sans rancune
      0