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

Résolu/Fermé
Aki - 27 juil. 2016 à 14:53
ccm81 Messages postés 10853 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 24 avril 2024 - 27 juil. 2016 à 18:01
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
A voir également:

5 réponses

ccm81 Messages postés 10853 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 24 avril 2024 2 404
27 juil. 2016 à 15:13
Bonjour

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

Cdlmnt
1
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
ccm81 Messages postés 10853 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 24 avril 2024 2 404
27 juil. 2016 à 16:46
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
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
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
ccm81 Messages postés 10853 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 24 avril 2024 2 404
27 juil. 2016 à 18:01
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
ccm81 Messages postés 10853 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 24 avril 2024 2 404
Modifié par ccm81 le 27/07/2016 à 15:23
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
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

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

Posez votre question
ccm81 Messages postés 10853 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 24 avril 2024 2 404
Modifié par ccm81 le 27/07/2016 à 15:59
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
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
http://www.cjoint.com/c/FGBoBbgRes1
0
PS : J'ai plein d'autres questions su le même fichier si tu es dispo...
0
ccm81 Messages postés 10853 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 24 avril 2024 2 404
27 juil. 2016 à 17:37
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
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