XL 2016 Conserver couleur choisie avec la macro existante

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
Bonjour à toutes & à tous, bonjour @Al1_44
je rencontre une erreur sur la ligne :
"If tablo(i, 14) Like "*MFI*" Then P(i, 14).Interior.Color = RGB(217, 217, 217)"

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...

AtTheOne

XLDnaute Accro
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

Al1_44

XLDnaute Junior
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
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
 

AtTheOne

XLDnaute Accro
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

Al1_44

XLDnaute Junior
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
Merci AtTheOne,
Impec, cela fonctionne mieux.
Je fais quelques essais et je clôture le post.
Bonne fin de WE à tous!
 

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,
 

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
 

AtTheOne

XLDnaute Accro
Supporter XLD
Bonjour à tous, bonjour @patricktoulon, bonjour @Al1_44

et P = Range("A1", UsedRange)
MsgBox P.Address

renvoie A1:N10 alors que le range est A1:N9
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
 

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 😂
 

AtTheOne

XLDnaute Accro
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

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
 

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

Discussions similaires

Réponses
26
Affichages
569

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 827
Messages
2 092 557
Membres
105 451
dernier inscrit
mariane_lp