If aucune cellule colorée dans ligne then "x" dans dernière col

Résolu
Aki -  
ccm81 Messages postés 11033 Statut Membre -
Bonjour,
J'ai de nombreuses conditions de type :
If Range("J" & i) = 0 Then
Range("J" & i).Interior.Color = RGB(255, 0, 0)
End If
If Range("CL" & i) = 0 And Range("CM" & i) <> 0 Then
Range("CL" & i).Interior.Color = RGB(255, 0, 0) And Range("CM" & i).Interior.Color = RGB(255, 0, 0) ': rouge
End If

Les couleurs et les colonnes varient et le nombre de colonnes est extensible.

J'aimerais créer via VBA une colonne "contrôle"
=> la dernière colonne de mon tableau sans donnée titre (ligne 1)
La nommer "contrôle"
Et ajouter un "x" si au moins l'une des cellule de la ligne n'est pas incolore.

Je remercie par avance les personnes qui prendront le temps de me répondre.

Aki

5 réponses

  1.
    ccm81 Messages postés 11033 Statut Membre 2 434
     
    Bonjour

    Un exemple
    http://www.cjoint.com/c/FGBnnm0icne

    Cdlmnt
    1
    1. Aki
       
      Bonjour ccm81 et merci!!!
      Je vois une lueur d'espoir :)
      C'est exactement ce qu'il me faut, par contre je n'ai pas les connaissances nécessaires pour comprendre toute ta macro.
      Si tu veux bien : A quoi correspond le "C" dans ta ligne
      cofin = .Cells(1, Columns.Count).End(xlToLeft).Column
      .Cells(1, cofin + 1).Value = "C"

      Merci Merci Merci et encore Merci :D
      0
  2. ccm81 Messages postés 11033 Statut Membre 2 434
     
    Je n'arrive pas à faire fonctionner ton fichier (erreur d'exécution 32809)
    Il te faut
    1. soit ajouter le x en ligne i au moment où tu colories une des cellules
    c'est assez simple à faire
    1.1. déterminer la dernière colonne Dercol (comme dans ma procédure)
    1.2. ajouter le x dans cette colonne au moment où tu mets une couleur (dans chaque if .... 
    'colorer les cellules vides => Colonne J
        If Range("J" & i) = 0 Then
            Range("J" & i).Interior.Color = RGB(255, 0, 0)  ': rouge
            Cells(dercol+1,i).value = "x"
         End If

    2. soit tester une fois que tout est fini en déportant la procedure test en dehors de la procédure controle 

    'colorer les cellules CL=0 ET CM<>0 => Colonne CL ET CM
        If Range("CL" & i) = 0 And Range("CM" & i) <> 0 Then
            Range("CM" & i).Interior.Color = RGB(255, 0, 0) ': rouge
            End If
    'Next
    Next
    Call test
    End Sub

    Sub test()
    'Ajouter un "X" si ligne à contrôler
    Const lideb = 2
    Const codeb = 1
    Dim cofin As Long, co As Long, li As Long, lifin As Long
    With ActiveSheet
      lifin = .Cells(Rows.Count, 1).End(xlUp).Row
      cofin = .Cells(1, Columns.Count).End(xlToLeft).Column
      .Cells(1, cofin + 1).Value = "Contrôle"
      For li = lideb To lifin
       For co = codeb To cofin
         If .Cells(li, co).Interior.ColorIndex <> xlNone Then
           .Cells(li, cofin + 1).Value = "X"
           Exit For
         End If
       Next co
     Next li
    End With
    End Sub


    Cdlmnt
    1
    1. Aki
       
      Ok merci
      Je teste la 2e solution car je n'ai pas réussi à faire fonctionner DernCol que j'ai tout de même laissé en commentaire.
      Je croise les doigts.
      0
    2. Aki
       
      Youhouuuuuuuuuuuuuuuuuuuuuuuuuuu!!!!
      Mille mercis :D
      Plein de gros énormes méga bisous (oui je me lache parce que je suis derrière mon pc).
      Je suis trop happy, encore merci.
      0
  3. ccm81 Messages postés 11033 Statut Membre 2 434
     
    J'ai fini par le faire fonctionner (il me faut contourner les lacunes de mon vieil excel 2003 )
    Pour accélérer un peu l'exécution
    dans la procedure test
    avant with activesheet, tu ajoutes
    Application.ScreenUpdating = False
    et avant le End sub
    Application.ScreenUpdating = True

    Bonne fin de journée
    1
  4. ccm81 Messages postés 11033 Statut Membre 2 434
     
    cofin = .Cells(1, Columns.Count).End(xlToLeft).Column
    est la dernière colonne non vide de la ligne 1

    .Cells(1, cofin + 1).Value = "C"
    C'est le titre de la colonne (C comme Contrôle). Celà suppose que la colonne qui suit la dernière contenant les données à traiter est vide, si ce n'est pas le cas, il faut modifier un peu, tu dis.

    Cdlmnt
    0
    1. Aki
       
      Elle est bien vide.
      "C" Comme "Contrôle" pour mon titre... Ne suis-je pas bêta?!!!

      J'ai lancé la macro sur mon fichier et à présent j'attends le résultat.
      J'attends...
      Je me demande si j'ai collé ton code au bon endroit.
      Il me semble que je vais devoir forcer l'arrêt d'Excel qui a planté :(

      Ah ben non, ça n'a pas planté. Par contre le résultat est bizarre.
      C C C C C C C C C C C C C C C C C C
      x x x x x x x x x x x x x x x x x
      x x x x x x x x x x x x x x x x
      x x x x x x x x x x x x x x x
      x x x x x x x x x x x x x x
      x x x x x x x x x x x x x
      x x x x x x x x x x x x




      x x x x x x x
      x x x x x x
      x x x x x
      x x x x

      Je pense qu'une fois la colonne trouvée et nommée "C" il faut la figer car à la ligne suivante il recherche à nouveau la dernière colonne sans titre.
      Une idée?
      0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. ccm81 Messages postés 11033 Statut Membre 2 434
     
    1. Est ce qu'avec mon fichier ça donne le résultat attendu ?

    2. Je pense que tu as dû mal copier le code, je te le remets avec quelques explications 

    Option Explicit

    Const lideb = 2   ' première ligne des données
    Const codeb = 1   ' première colonne des données

    Public Sub OK()
    Dim cofin As Long, co As Long, li As Long, lifin As Long
    ' depuis la feuille active
    With ActiveSheet
      ' dernière ligne de la colonne codeb
      lifin = .Cells(Rows.Count, codeb).End(xlUp).Row
      ' dernière colonne de la ligne 1
      cofin = .Cells(1, Columns.Count).End(xlToLeft).Column
      ' titre sur la ligne 1 de la colonne cofin+1
      .Cells(1, cofin + 1).Value = "C"
      ' boucle sur les lignes
      For li = lideb To lifin
       ' boucle sur les colonnes de la ligne li
       For co = codeb To cofin
         ' si la cellule (li,co) est colorée
         ' on met un x en colonne cofin+1
         ' on quitte la boucle for co ...
         If .Cells(li, co).Interior.ColorIndex <> xlNone Then
           .Cells(li, cofin + 1).Value = "x"
           Exit For
         End If
       Next co
     Next li
    End With
    End Sub

    3. Si ça ne va toujours pas, envoies un bout de ton fichier

    Cdlmnt
    0
    1. Aki
       
      Je pense effectivement que l'emplacement est mal choisi car pour chaque If then effectif j'ai une colonne créée :

      Private Sub Controle_Click()
      Dim nb_lignes As Integer ', DernCol As Integer ', Ctr As Integer
      nb_lignes = WorksheetFunction.CountA(Range("A:A"))


      Sheets("VERIFAPRESPAIE").Activate

      For i = 1 To nb_lignes
      'For Ctr = 1 To DernCol


      'supprimer les couleurs déjà existantes
      'Range(Ctr & i).Interior.ColorIndex = xlNone

      'colorer les cellules vides => Colonne J
      If Range("J" & i) = 0 Then
      Range("J" & i).Interior.Color = RGB(255, 0, 0) ': rouge
      End If
      'colorer les cellules comprenant une date = mois en cours => Colonne O
      'colorer les contenant le texte "Chèque " => Colonne U
      If Range("U" & i) = "Chèque " Then
      Range("U" & i).Interior.Color = RGB(255, 0, 0)
      End If
      'colorer les cellules < 0 => Colonne BI
      If Range("BI" & i) < 0 Then
      Range("BI" & i).Interior.Color = RGB(255, 0, 0) ': rouge
      End If
      'colorer les cellules <> 0 => Colonne BO
      If Range("BO" & i) <> 0 Then
      Range("BO" & i).Interior.Color = RGB(255, 0, 0) ': rouge
      End If
      'colorer les cellules <> 0 => Colonne BP
      If Range("BP" & i) <> 0 Then
      Range("BP" & i).Interior.Color = RGB(255, 0, 0) ': rouge
      End If
      'colorer les cellules <> 0 => Colonne BQ
      If Range("BQ" & i) <> 0 Then
      Range("BQ" & i).Interior.Color = RGB(255, 0, 0) ': rouge
      End If

      'colorer les cellules <> 0 => Colonne BR
      If Range("BR" & i) <> 0 Then
      Range("BR" & i).Interior.Color = RGB(255, 0, 0) ': rouge
      End If
      'colorer les cellules CH=0 ET CJ<>0 => Colonne CJ
      If Range("CH" & i) = 0 And Range("CJ" & i) <> 0 Then
      Range("CJ" & i).Interior.Color = RGB(255, 0, 0) ': rouge
      End If

      'colorer les cellules CI=0 ET CK<>0 => Colonne CK
      If Range("CI" & i) = 0 And Range("CK" & i) <> 0 Then
      Range("CK" & i).Interior.Color = RGB(255, 0, 0) ': rouge
      End If

      'colorer les cellules CL=0 ET CM<>0 => Colonne CL ET CM
      If Range("CL" & i) = 0 And Range("CM" & i) <> 0 Then
      Range("CM" & i).Interior.Color = RGB(255, 0, 0) ': rouge
      End If

      'Ajouter un "X" si ligne à contrôler
      Const lideb = 2
      Const codeb = 1
      Dim cofin As Long, co As Long, li As Long, lifin As Long
      With ActiveSheet
      lifin = .Cells(Rows.Count, 1).End(xlUp).Row
      cofin = .Cells(1, Columns.Count).End(xlToLeft).Column
      .Cells(1, cofin + 1).Value = "Contrôle"
      For li = lideb To lifin
      For co = codeb To cofin
      If .Cells(li, co).Interior.ColorIndex <> xlNone Then
      .Cells(li, cofin + 1).Value = "X"
      Exit For
      End If
      Next co
      Next li
      End With

      'Next
      Next
      End Sub
      0
    2. Aki
       
      http://www.cjoint.com/c/FGBoBbgRes1
      0
    3. Aki
       
      PS : J'ai plein d'autres questions su le même fichier si tu es dispo...
      0
    4. ccm81 Messages postés 11033 Statut Membre 2 434
       
      1. Il vaut mieux ouvrir une nouvelle discussion
      2. Tu devrais t'inscrire comme membre, c'est gratuit, ça facilite l'accès aux fichiers joints (liens hypertexte) et en plus tu as accès à la messagerie personnelle
      3. Pour ton fichier, je te rappelle que je ne peux pas exécuter ta macro Controle !

      Cdlmnt
      0
    5. Aki
       
      1-J'ai ouvert une autre discussion [If date=mois en cours then...]
      2-Je m'inscrit fais de ce pas
      3-Le bouton pour exécuter la macro est en cellule A1 mais c'est surement autre chose qui bloc car chez moi ça fonctionne.
      Merci encore des millions de fois ccm81
      0

Discussions similaires

Dimensions L x l x H : comment lire ces infos ?
Miss-Curieuse -
valou -

8 réponses
ecouteurs bluetooth Homday X-Pert
Ambro -
Wilfried -

10 réponses