Microsoft 365 Report de format couleur dans cellule hors MFC

JBL07

XLDnaute Occasionnel
Bonjour le Forum,

Je fais à nouveau appel à vos compétences !

J'ai un fichier de report de prix/articles par dates d'achat et magasin
Il y a colonne E une cellule par ligne ( 1 article = 1 ligne ) qui indique le prix mini de toutes les fois où cet article a été acheté
Le moyent d'identifier dans le tableau le magasin où ce prix mini a été trouvé est un code couleur, sur le prix à cette date
Je voudrais que le code couleur de l'achat en question soit reporté dans la cellule prix mini

Et je ne trouve point la solution ! :rolleyes:
Pouvez-vous m'y aider ?

Merci par avance !
 

Pièces jointes

  • Fichier exemple.xlsm
    11.7 KB · Affichages: 13
Solution
Bonjour.
Avec ça dans un un module standard :
VB:
Option Explicit
Private Consignes As New Collection
Function Coloré(ByVal Cel As Range)
   Coloré = Cel.Value
   Consignes.Add Application.Caller
   Consignes.Add Cel.Font.Color
   End Function
Sub ExécuterConsignes()
   Dim Cel As Range, FCr As Long
   While Consignes.Count > 0
      Set Cel = Consignes(1): Consignes.Remove 1
      FCr = Consignes(1): Consignes.Remove 1
      Cel.Font.Color = FCr
      Wend
   End Sub
Dans le module de l'objet Worksheet qui représente la feuille :
Code:
Private Sub Worksheet_Calculate()
   ExécuterConsignes
   End Sub
En E5, à propager sur 4 lignes :
Code:
=Coloré(DECALER(E5;0;EQUIV(MIN(F5:WW5);F5:WW5;0)))
Le changement de la couleur de police doit...

Dranreb

XLDnaute Barbatruc
Bonjour.
Avec ça dans un un module standard :
VB:
Option Explicit
Private Consignes As New Collection
Function Coloré(ByVal Cel As Range)
   Coloré = Cel.Value
   Consignes.Add Application.Caller
   Consignes.Add Cel.Font.Color
   End Function
Sub ExécuterConsignes()
   Dim Cel As Range, FCr As Long
   While Consignes.Count > 0
      Set Cel = Consignes(1): Consignes.Remove 1
      FCr = Consignes(1): Consignes.Remove 1
      Cel.Font.Color = FCr
      Wend
   End Sub
Dans le module de l'objet Worksheet qui représente la feuille :
Code:
Private Sub Worksheet_Calculate()
   ExécuterConsignes
   End Sub
En E5, à propager sur 4 lignes :
Code:
=Coloré(DECALER(E5;0;EQUIV(MIN(F5:WW5);F5:WW5;0)))
Le changement de la couleur de police doit toutefois être effectué avant de taper la valeur du prix.
 

danielco

XLDnaute Accro
Utilise :

VB:
Sub test()
  Dim C As Range, Min As Range, Plage As Range, X As Range
  For Each C In Range("A5", Cells(Rows.Count, 1).End(xlUp)).Offset(, 4)
    Set Plage = Range(C.Offset(, 1), Cells(C.Row, Columns.Count).End(xlToLeft))
    For Each X In Plage
      If X.Value = C.Value Then
        C.Font.Color = X.Font.Color
        Exit For
      End If
    Next X
  Next C
End Sub

Si tu ne sais pas installer la macro, dis-le.

Daniel
 

danielco

XLDnaute Accro
Bonjour.
Avec ça dans un un module standard :
VB:
Option Explicit
Private Consignes As New Collection
Function Coloré(ByVal Cel As Range)
   Coloré = Cel.Value
   Consignes.Add Application.Caller
   Consignes.Add Cel.Font.Color
   End Function
Sub ExécuterConsignes()
   Dim Cel As Range, FCr As Long
   While Consignes.Count > 0
      Set Cel = Consignes(1): Consignes.Remove 1
      FCr = Consignes(1): Consignes.Remove 1
      Cel.Font.Color = FCr
      Wend
   End Sub
Dans le module de l'objet Worksheet qui représente la feuille :
Code:
Private Sub Worksheet_Calculate()
   ExécuterConsignes
   End Sub
En E5, à propager sur 4 lignes :
Code:
=Coloré(DECALER(E5;0;EQUIV(MIN(F5:WW5);F5:WW5;0)))
Le changement de la couleur de police doit toutefois être effectué avant de taper la valeur du prix.

Bonjour @Dranreb,

Désolé, je n'avais pas rafraichi l'écran.

Daniel
 

JBL07

XLDnaute Occasionnel
Merci pour vos réponses !

J'ai installé les codes indiqués par Danreb, ça fonctionne parfaitement, le seul problème est qu'à chaque validation d'une modification ( saisie d'un prix, changement couleur de police...), il faut à Excel entre 7 à 10 secondes pour valider ( avec un petit passage par "excel ne répond pas", qui s'annule tout seul.
J'ai pourtant réduit la plage de recherche ( de F5:WW5 à F5:BZ5) , mais c'est pareil

J'avoue que c'est trop lent et à chaque fois je me demande si ça va planter ... une idée ?

Pour info, je ne sais pas comment tenir compte du code de Daniel : c'est une autre façon de faire ? Si je dois la tester, il me faut plus d'indications pour installer la macro :)
 

danielco

XLDnaute Accro
Pour installer la macro, fais un clic droit sur un onglet, clique sur "visualiser le code". Dans la fenêtre VBE, repère le VBAProject qui porte le nom de ton classeur. Fais un clic droit dessus, clique sur "Insertion" et sur "Module" et colle le code dans la partie droite de la fenêtre. La macro doit être lancée manuellement.

Daniel
 

JBL07

XLDnaute Occasionnel
Merci Daniel,

Je conserve précieusement ces indications et la macro dans cette discussion
J'ai contourné le pb : les feuilles (4) concernées par ce dossier font partie d'un très classeur comportant déjà beaucoup de macros et formules - Je les ai donc extraites dans un classeur à part, du coup plus de délai dans le traitement, ça me va très bien.

Merci à vous deux pour vos retours rapides et efficaces :)
 

JBL07

XLDnaute Occasionnel
Bonjour,

Je reviens vers vous car finalement, le code fonctionne dans un fichier seul.. mais je l'ai intégré dans un classeur qui comporte une autre code ( pour un filtre ), et cela ne fonctionne plus - Voici le bug lorsque je tente de faire fonctionner le tableau.

1589312700653.png


J'ai essayé tout ce que j'ai pu, mais bon.. toujours aussi peu efficace !
Si vous pouvez m'aider, ce serait bien, merci :)
 

Discussions similaires