XL 2016 Mise en couleur cellule par rapport à une autre cellule.

[Patron28]

Bonjour,

J'aimerai réaliser la mise en couleur de cellules par rapport à d'autres cellules avec condition, mais j'ai un souci pour réaliser cela. Je voudrais utiliser la mise en forme conditionnel ou la fonction si mais je bloque.

J'aimerai sans macro. Voir le fichier en pièce jointe.

Voici l'explication : Si la cellule d2=10, mettre en couleur toutes les cellules du tableau g2/g20 qui corresponde à d2 de la même couleur que D2, en sachant que la couleur de D2 peut changer

Si la cellule D4=5, mettre en couleur toutes les cellules du tableau G2/G20 qui corresponde à D4 de la même couleur que D4.

ETC........

Si cela n’est pas possible sans macro, alors ok, mais ce fichier doit être inséré dans un autre classeur avec plusieurs feuilles, faudra juste m’expliquer comment faire fonctionner la macro.

Merci pour votre aide.

Bonne journée

Patron28

 

[Patron28]

Il faut changer toute la macro ou juste insérer displayformat.interior.color ?

Merci pour la réponse

Patron28

 

[Dranreb]

Je déconseille vraiment de s’appuyer sur des couleurs obtenues par MFC. Parce que ça veut dire que la source de l'information purement visuelle est ailleurs et d'une autre nature et c'est sur celle ci qu'il faut s'appuyer, sinon c'est du bricolage.

 

[Patron28]

Je vais mettre un fichier explicatif en soirée, là je vais allez bosser.

Merci pour l'aide.

Patron28

 

[patricktoulon]

En D2 c'est un chiffre de 1 à 10 , ou rien
En D4 c'est un chiffre de 1 à 10 , ou rien mais en aucun cas les mêmes chiffres que D2.

En D211 se sont des chiffres de 1 à 10 ou rien. jamais de doublon

ok ne reste plus qu'a raisonner sur le retour en cas de changement vers rien

je tape 10 en D2 et donc le G4 et H8 qui sont égales a D2 prennent la couleur de D2

maintenant D2 change et devient 6 la H3 et Q7 qui sont égales a 6 prennent la couleur de D2

ok oui MAIS la G4 et H8 qu'est ce qu'elles deviennent dans l'histoire elles correspondent plus a D2
c'est question dont visiblement tu es incapable de me répondre concrètement et clairement
et cela depuis le post #3
maintenant si tu me dis non en fait !!! on vérifie tout au change D UNE!!!! DES CELLULES DE "D"
là oui on se comprend, il est alors inutile d'usiner un code pour boucler sur 10 cells

par contre si c'est bien un change distinct D2 OU !!! D4 OU !! D5 etc... la tu va avoir un souci d'incohérence sur les retours

 

[Dranreb]

Ben là j'ai un code qui s'occupe des interversions en D2:D11.
Pas testé à fond.

Option Explicit
Private AncIndice As Long, Posit() As Long, Cible As Interior, Couleur As Long, ÇaTourne As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim TNum(1 To 10, 1 To 1) As Long, N As Long, P As Long
   If AncIndice > 0 Then
      For N = 1 To 10: TNum(Posit(N), 1) = N: Next N
      N = Target.Value
      TNum(Posit(AncIndice), 1) = N: TNum(Posit(N), 1) = AncIndice
      Application.EnableEvents = False
      Me.[D2:D11].Value = TNum
      Application.EnableEvents = True
      End If
   ChangerLesCouleurs
   End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim TNum(), L As Long
   If Intersect(Me.[D2:D11], Target) Is Nothing Then
      ÇaTourne = False: AncIndice = 0
   Else
      TNum = Me.[D2:D11].Value: ReDim Posit(1 To 10): AncIndice = Target.Value
      For L = 1 To 10: Posit(TNum(L, 1)) = L: Next L
      Set Cible = Target.Interior: Couleur = Cible.Color
      If ÇaTourne Then Exit Sub
      ÇaTourne = True
      While ÇaTourne: DoEvents
         If Cible.Color <> Couleur Then
            Couleur = Cible.Color: ChangerLesCouleurs: End If: Wend: End If
   End Sub
Sub ChangerLesCouleurs()
   Dim Rng As Range, TCoul(1 To 10), Cel As Range
   Set Rng = Range("D2:D11")
   For Each Cel In Rng
      TCoul(Cel.Value) = Cel.Interior.Color
      Next Cel
   Set Rng = Range("G2:Q11")
   For Each Cel In Rng
      Cel.Interior.Color = TCoul(Cel.Value)
      Next Cel
   End Sub

Pourrait certainement s'étendre aux colones de G2:G11

 

[patricktoulon]

perso je pense que c'est inutile de tricoter
une cellule change en "D"
alors verif de toutes les cells de GQ et changement de couleur par rapport au cells de "D"
tu a l'aller et le retour en même temps
10 lignes de code au grand max et encore!!!
peut être a peine 2 ou trois de plus pour empêcher les doublons en "D"
bref je suis pour voir comment vous allez faire

 

[Dranreb]

Certes. Mon propos c'était seulement de réagir aussi dès qu'on change une couleur de fond en D2:D11, et donc d'y arriver bien qu'aucun évènement ne soit déclenché quand ça se produit.

 

[patricktoulon]

Dranreb pour le timer tu connais ma méthode avec le pseudo timer plus rapide que app.ontime, moins lourd, il passe quasiment inaperçu
il servirait a modifier les couleurs de GQ quand elles changent dans "D" sans déclencher d'events

tu sais que je serais jamais d'accords avec çà

 While ÇaTourne: DoEvents
         If Cible.Color <> Couleur Then
            Couleur = Cible.Color: ChangerLesCouleurs: End If: Wend: End If

perso je trouve impensable une boucle perpétuelle même soulagée par un doevents et un (start/stoper)pour un contrôle de couleur de 10 cellules

 

[Patron28]

"je tape 10 en D2 et donc le G4 et H8 qui sont égales a D2 prennent la couleur de D2

maintenant D2 change et devient 6 la H3 et Q7 qui sont égales a 6 prennent la couleur de D2

ok oui MAIS la G4 et H8 qu'est ce qu'elles deviennent dans l'histoire elles correspondent plus a D2 "

Bon comme expliqué plus haut, D2 comprendra un chiffre de 1 à 10, D3 pareil D4 pareil ....jusque D11
De D2 à D11 un chiffre de 1 à 10 sans doublon donc pour répondre à Patrick, G4 et H8 prendront la couleur correspondante a une case de D3 à D11 puisque D2 à changé.

Je voulais mettre un fichier avec une MFC mais vu que vous travaillez avec le fichier classique, je ne le met pas.( je ferais avec le fichier du début ).

Patron28

 

[patricktoulon]

re
bonjour
bon au matin a la fraîche
vire tout le code de de partout dans le fichier
et dans le module thisworkbook tu va mettre ceci

Option Explicit
Private WithEvents Cmbrs As CommandBars    'creation de l'object commandbars events
Public p As Range
Public tbl
'evenement commandbars
Private Sub Cmbrs_OnUpdate()
    Dim i&
    Application.CommandBars.FindControl(ID:=2040).Enabled = Not Application.CommandBars.FindControl(ID:=2040).Enabled
    For i = 1 To UBound(tbl)
        If tbl(i, 1) <> p.Cells(i).Interior.Color Or tbl(i, 2) <> p.Cells(i).Value Then quelquechose_en_D2_D11_Change (i)
    Next
End Sub

'evenement pipopipo quelquechose_en_D2_D11_Change de la plage D2:D11
Private Sub quelquechose_en_D2_D11_Change(theRow)
    Dim cel As Range, i&
    tbl(theRow, 1) = p.Cells(theRow).Interior.Color
    For Each cel In Feuil1.Range("G2:Q11").Cells
        If cel.Value = tbl(theRow, 2) Then cel.Interior.Color = xlNone 'on enleve la couleur
    Next
    tbl(theRow, 2) = IIf(p.Cells(theRow) = "", "|", p.Cells(theRow).Value) 'pour ne pas confondre le 0 et le vide
    For Each cel In Feuil1.Range("G2:Q11").Cells
        If cel.Value = tbl(theRow, 2) Then cel.Interior.Color = tbl(theRow, 1) 'on remet la couleur
    Next
End Sub



Private Sub Workbook_Open()
    Dim i&
    Set p = Feuil1.[D2:D11]
    ReDim tbl(1 To p.Cells.Count, 1 To 2)
    For i = 1 To UBound(tbl): tbl(i, 1) = p.Cells(i).Interior.Color: tbl(i, 2) = p.Cells(i).Value: Next
     Set Cmbrs = Application.CommandBars
End Sub

ensuite tu sauve le classeur et tu le ré ouvre
désormais si tu change un chiffre ou efface une cellule ou change une couleur en D211 le tableau G2:Q11 subira les même changement en même temps
si tu efface une cellules en D211 les cellules qui AVAIENT!!!! la même valeur redeviennent blanches
testez avec ce fichier

 

[Patron28]

Bonjour

Merci pour ta solution et le fichier Patrick.

Cela fonctionne bien

Patron28

 

[patricktoulon]

de rien
et pour ne pas avoir des doublons en D211
tu ajoute ça au même endroit

ainsi si tu tape un numero existant si il est déjà présent l’opération s'annule est la cellule revient a sa précédente valeur

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 4 And Target.Count = 1 Then
 If Target.Value <> Empty Then If Application.CountIf([D2:D11], Target.Value) > 1 Then Application.Undo
End If
End Sub

il me semble que c'est le point N°2 de ta demande

 

[Patron28]

Bonjour Patrick,

Merci pour la mise à jour du fichier super.

Juste une question, pourquoi faut-il mettre le code de la macro dans le workbook de la feuil et pas directement sur la feuil ?
Comment mettre ta macro dans un fichier existant avec d'autres macro et déjà un workBook ?

Merci pour ta réponse.

Patron28

 

[patricktoulon]

Bonjour
c'est une manie que j'ai de classer
d'ailleur c'est d'abords une classe events commandbars et tu ne peux classer des object que dans des modules classes thisworkbook en est un de même que les userform et les modules du même non dit modules classe
pour ajouter ben si tu utilise déjà les events tu ajoute le code dans l'events sinon tu met toutes la sub