XL 2016 Conserver couleur choisie avec la macro existante

A

Al1_44

XLDnaute Junior
Bonjour le forum,
Comment conserver la couleur jaune des cellules de la colonne N avec la macro existante?
La macro me permet de mettre certaines cellules en bleu et de les mettre en blanc une fois ces cellules remplies.
Et bien évidement lorsque je colore en jaune les cellules, cela fonctionne jusqu'à la prochaine saisie.
Bien à vous,
AL1
 

Pièces jointes

  • AL44-3.xlsm
    17 KB · Affichages: 15
Solution
AtTheOne
Bonjour à toutes & à tous, bonjour @Al1_44
Al1_44 à dit:
je rencontre une erreur sur la ligne :
"If tablo(i, 14) Like "*MFI*" Then P(i, 14).Interior.Color = RGB(217, 217, 217)"
Cliquez pour agrandir...

Normal, il y a 2 problèmes :
  1. P est un objet range = syntaxe correcte est :
    Enrichi (BBcode): 
    If tablo(i, 14) Like "*MFI*" Then P.cells(i, 14).Interior.Color = RGB(217, 217, 217)
  2. tablo(i,14) peut contenir des valeurs d'erreurs à cause de la formule :
    Code: 
    =SI(M6>0;RECHERCHEV(M6;'détail FRI'!B:K;2;FAUX);"")
    C'était le cas ligne 178 où l'on obtenait N/A# car M178 contient "MSBICS450W" qui n'est pas une référence Article. En plus les références Article ne sont pas toutes numériques cas également de M177 qui vaut "2150330015A" !
    à remplacer par...
Trier par date Trier par votes
AtTheOne

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonjour à tous, bonjour @Al1_44

En modifiant un peu ton code (le moins possible) ton code en italique, modifs en vert, déplacements en bleu
Enrichi (BBcode): 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim P As Range, tablo, i&, N As Range
     Application.ScreenUpdating = False
    
     Set P = Range("A1", UsedRange)
     tablo = P 'matrice, plus rapide
     Set N = P.Columns("N")
    
     ReDim tbColIdx(1 To UBound(tablo))
     For i = 1 To UBound(tablo)
          tbCidx(i) = N.Cells(i).Interior.ColorIndex
     Next
    
     [E:E,H:H,J:J,N:N].Interior.ColorIndex = xlNone 'RAZ
    
     For i = 1 To UBound(tablo)
         If Not IsEmpty(tablo(i, 3)) Then If Not IsEmpty(tablo(i, 4)) Then _
             If IsEmpty(tablo(i, 5)) Or IsEmpty(tablo(i, 10)) Or IsEmpty(tablo(i, 14)) _
                 Then Union(P(i, 5), P(i, 10), P(i, 14)).Interior.Color = 15773696 'bleu
                     If tablo(i, 7) Like "*occasion*" And tablo(i, 8) Like "*lu*" Then P(i, 8).Interior.Color = 5296274 'vert
     Next
    
     For i = 1 To UBound(tablo)
          If tbCidx(i) = 6 Then N.Cells(i).Interior.ColorIndex = 6
     Next

     [A1:N3].Interior.Color = RGB(190, 210, 240)     'Remise en bleu de l'entete
     Application.ScreenUpdating = True
End Sub
:
Voir la PJ
Amicalement
Alain
 

Pièces jointes

  • AL44-3.xlsm
    17.5 KB · Affichages: 6
Vote positif 0 Vote négatif
A

Al1_44

XLDnaute Junior
AtTheOne à dit:
Bonjour à tous, bonjour @Al1_44

En modifiant un peu ton code (le moins possible) ton code en italique, modifs en vert, déplacements en bleu
Enrichi (BBcode): 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim P As Range, tablo, i&, N As Range
     Application.ScreenUpdating = False
    
     Set P = Range("A1", UsedRange)
     tablo = P 'matrice, plus rapide
     Set N = P.Columns("N")
   
     ReDim tbColIdx(1 To UBound(tablo))
     For i = 1 To UBound(tablo)
          tbCidx(i) = N.Cells(i).Interior.ColorIndex
     Next
   
     [E:E,H:H,J:J,N:N].Interior.ColorIndex = xlNone 'RAZ
   
     For i = 1 To UBound(tablo)
         If Not IsEmpty(tablo(i, 3)) Then If Not IsEmpty(tablo(i, 4)) Then _
             If IsEmpty(tablo(i, 5)) Or IsEmpty(tablo(i, 10)) Or IsEmpty(tablo(i, 14)) _
                 Then Union(P(i, 5), P(i, 10), P(i, 14)).Interior.Color = 15773696 'bleu
                     If tablo(i, 7) Like "*occasion*" And tablo(i, 8) Like "*lu*" Then P(i, 8).Interior.Color = 5296274 'vert
     Next
   
     For i = 1 To UBound(tablo)
          If tbCidx(i) = 6 Then N.Cells(i).Interior.ColorIndex = 6
     Next

     [A1:N3].Interior.Color = RGB(190, 210, 240)     'Remise en bleu de l'entete
     Application.ScreenUpdating = True
End Sub
:
Voir la PJ
Amicalement
Alain
Cliquez pour agrandir...
Bonjour AtTheOne,
Merci pour ton aide, mais je rencontre un problème "Erreur de compilation" à la ligne,
"tbCidx(i) = N.Cells(i).Interior.ColorIndex".
Bien à toi
AL1
 
Vote positif 0 Vote négatif
AtTheOne

AtTheOne

XLDnaute Impliqué
Supporter XLD
Re ...
J'ai fait un changement de nom de tableau intempestif, sans le répercuter partout !
Enrichi (BBcode): 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim P As Range, tablo, i&, N As Range
     Application.ScreenUpdating = False
    
     Set P = Range("A1", UsedRange)
     tablo = P 'matrice, plus rapide
     Set N = P.Columns("N")
    
     ReDim tbColIdx(1 To UBound(tablo))
     For i = 1 To UBound(tablo)
          tbColIdx(i) = N.Cells(i).Interior.ColorIndex
     Next
    
     [E:E,H:H,J:J,N:N].Interior.ColorIndex = xlNone 'RAZ
    
     For i = 1 To UBound(tablo)
         If Not IsEmpty(tablo(i, 3)) Then If Not IsEmpty(tablo(i, 4)) Then _
             If IsEmpty(tablo(i, 5)) Or IsEmpty(tablo(i, 10)) Or IsEmpty(tablo(i, 14)) _
                 Then Union(P(i, 5), P(i, 10), P(i, 14)).Interior.Color = 15773696 'bleu
                     If tablo(i, 7) Like "*occasion*" And tablo(i, 8) Like "*lu*" Then P(i, 8).Interior.Color = 5296274 'vert
     Next
    
     For i = 1 To UBound(tablo)
          If tbColIdx(i) = 6 Then N.Cells(i).Interior.ColorIndex = 6
     Next

     [A1:N3].Interior.Color = RGB(190, 210, 240)     'Remise en bleu de l'entete
     Application.ScreenUpdating = True
End Sub

Ça devrait aller mieux maintenant

Amicalement
Alain
 

Pièces jointes

  • AL44-3.xlsm
    17.6 KB · Affichages: 4
Vote positif 0 Vote négatif
A

Al1_44

XLDnaute Junior
AtTheOne à dit:
Re ...
J'ai fait un changement de nom de tableau intempestif, sans le répercuter partout !
Enrichi (BBcode): 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim P As Range, tablo, i&, N As Range
     Application.ScreenUpdating = False
   
     Set P = Range("A1", UsedRange)
     tablo = P 'matrice, plus rapide
     Set N = P.Columns("N")
   
     ReDim tbColIdx(1 To UBound(tablo))
     For i = 1 To UBound(tablo)
          tbColIdx(i) = N.Cells(i).Interior.ColorIndex
     Next
   
     [E:E,H:H,J:J,N:N].Interior.ColorIndex = xlNone 'RAZ
   
     For i = 1 To UBound(tablo)
         If Not IsEmpty(tablo(i, 3)) Then If Not IsEmpty(tablo(i, 4)) Then _
             If IsEmpty(tablo(i, 5)) Or IsEmpty(tablo(i, 10)) Or IsEmpty(tablo(i, 14)) _
                 Then Union(P(i, 5), P(i, 10), P(i, 14)).Interior.Color = 15773696 'bleu
                     If tablo(i, 7) Like "*occasion*" And tablo(i, 8) Like "*lu*" Then P(i, 8).Interior.Color = 5296274 'vert
     Next
   
     For i = 1 To UBound(tablo)
          If tbColIdx(i) = 6 Then N.Cells(i).Interior.ColorIndex = 6
     Next

     [A1:N3].Interior.Color = RGB(190, 210, 240)     'Remise en bleu de l'entete
     Application.ScreenUpdating = True
End Sub

Ça devrait aller mieux maintenant

Amicalement
Alain
Cliquez pour agrandir...
Merci AtTheOne,
Impec, cela fonctionne mieux.
Je fais quelques essais et je clôture le post.
Bonne fin de WE à tous!
 
Vote positif 0 Vote négatif
A

Al1_44

XLDnaute Junior
Bonjour le forum,

Une question sur la couleur à conserver, sur la ligne
"If tbColIdx(i) = 6 Then N.Cells(i).Interior.ColorIndex = 6"
Le 6 correspond à la couleur jaune, j'ai testé avec le code hex(53535) ou RGB(255,255,0) et cela ne fonctionne pas.
Quelle code faut-il apporté à la ligne?
amicalement,
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
déjà il faudrait voir si ce que tu instancie correspond a ce qui est

Set P = Range("A1", UsedRange)
MsgBox P.Address
renvoie A1:N10 alors que le range est A1:N9
il y a forcement par la suite une erreur d'index de variable tableau / cells
 
Vote positif 0 Vote négatif
AtTheOne

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonjour à tous, bonjour @patricktoulon, bonjour @Al1_44

patricktoulon à dit:
et P = Range("A1", UsedRange)
MsgBox P.Address
renvoie A1:N10 alors que le range est A1:N9
Cliquez pour agrandir...
C'est un problème connu du UsedRange et de Atteindre->"Dernière Cellule" : Lorsque l'on a saisie une valeur dans une cellule au-delà de la dernière cellule utilisée, même si on la supprime, "Dernière cellule" et UsedRange continuent à la prendre en compte.

La seule solution que je connaisse est d'utiliser la syntaxe ActiveSheet.UsedRange (seulement avec ActiveSheet !) pour réinitialiser la propriété UsedRange de la feuille active.
Parfois on est même contraint à supprimer les lignes ou les colonnes parasites (le effacer tout ne suffit pas) ...
Ça reste un mystère pour moi.

Quant à l'erreur, je suppose qu' @Al1_44 devait changer également le Stockage des couleurs, et le test, sinon, ça marche beaucoup moins bien !

Amicalement
Alain
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
non c'est pas un bug
tu fait un range multi area A1 avec usedrange

le usedrange fait tant de ligne et tant de colonne au quel tu ajoute donc a1 qui est inclue dans le usedrange total tu ajoute une ligne
d'autant plus que pourquoi cette union!!!??????? elle est inutile
il travaille avec une entête il a qu'a la laisser tranquille cette ligne
enfin je sais pas pour moi certaines choses sont évidentes pas besoins d’être un grand pro des macros
bien maladroit tout ça
oserais dire qu'il y a les MFC non!!...... je le dirais pas 😂
 
Vote positif 0 Vote négatif
AtTheOne

AtTheOne

XLDnaute Impliqué
Supporter XLD
Re @patricktoulon

Il y a quand même 1 schmilblick : Quand tu fais une saisie au-delà de la plage utilisée et que tu supprimes cette saisie, "Rechercher->Atteindre->dernière cellule" atteint cette cellule supprimée !

Quant à range("A1",UsedRange).address dans mon exemple cela affiche bien la bonne adresse.
La différence avec UsedRange est que si les premières cellules sont vides, Usedrange ne renverra que la plage occupée, alors que range("A1",UsedRange) renvoie une plage qui commence en A1

Dans le cas de @Al1_44, si je suis d'accord avec toi pour l'entête à laisser tranquille et l'utilisation des MFC, je me demande pourquoi sa syntaxe pointait vers "A1:N10" et non pas "A1:N9" !!!

Exécute la macro du fichier joint pour une illustration de mes propos .
(Testée avec Office2007 et Office2021)

Amicalement
Alain
 

Pièces jointes

  • Classeur UsdRg.xlsm
    16.8 KB · Affichages: 1
Vote positif 0 Vote négatif
A

Al1_44

XLDnaute Junior
Bonjour à vous,
Je vous remercie pour toute vos explications.
J'ai déjà ce fichier avec des MFC, mais il comporte quelques centaines de lignes et je fais beaucoup de copier/coller, cela génère pas mal de lignes à traiter dans la MFC.
En passant par une macro, je souhaitait apporter un petit plus.
Je transpose vos remarques sur mon "vrai" fichier de travail et je vous rendrais compte de la fiabilité du code.
Encore merci et bonne journée.
AL1
 
Vote positif 0 Vote négatif
A

Al1_44

XLDnaute Junior
Bonjour le forum,
J'ai transposé la macro sur mon fichier de travail et je rencontre une erreur sur la ligne :
"If tablo(i, 14) Like "*MFI*" Then P(i, 14).Interior.Color = RGB(217, 217, 217)"
La macro fonctionne très bien si on remplie les lignes au fur et à mesure, mais pas du tout sur le fichier complet existant.
D'avance merci
Bonne journée à tous,
AL1
 

Pièces jointes

  • AL44-4.xlsm
    761.3 KB · Affichages: 1
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 cellules vides et boite de dialogue
Réponses
2
Affichages
141
michel.dupont
M
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Affichage des résultats dans un tableau selon des conditions
Réponses
13
Affichages
275
chaelie2015
chaelie2015
chaelie2015
  • Résolu(e)
Autres (RESOLU) Restaurer la couleur d'origine
Réponses
4
Affichages
343
chaelie2015
chaelie2015
R
  • Résolu(e)
Microsoft 365 calculer une moyenne conditionnelle en retirant certaines valeurs par le biais de la couleur de fond d'une cellule
Réponses
7
Affichages
342
ricoben
R
D
  • Résolu(e)
Microsoft 365 Couleur lignes Listview à partir de la valeur d'une colonne
Réponses
4
Affichages
314
Diane272727
D
J
  • Question
XL 2019 mettre une couleur en arrière plan dans une cellule en fonction de la valeur d'une autre cellule
Réponses
1
Affichages
568
JLR67
J
D
  • Question
Microsoft 365 Macro pour enlever les filtres mais laisser la possibilité de filtrer avant fermeture
2
Réponses
25
Affichages
447
TooFatBoy
TooFatBoy
T
  • Question
XL 2016 La macro efface les formules
Réponses
3
Affichages
231
JHA
J
R
  • Résolu(e)
XL 2019 supprimer lignes vides qui ont été coupées - collées
Réponses
6
Affichages
285
rh.finances
R
D
  • Question
XL 2010 fond blanc et gris dans plusieurs tableaux
Réponses
1
Affichages
314
TooFatBoy
TooFatBoy

Membres actuellement en ligne

17 membres et 119 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 111
Messages
2 085 407
Membres
102 884
dernier inscrit
Macarena