XL 2010 Couleur sur cellule suivant rechercheV mais en VBA

[Meosus]

Bonsoir a tous,

Dans un tableau, j'aimerais colorié l'intérieur des cellules en colonne A suivant la valeur des cellules de la colonne B à partir d'un tableau de valeur sur la feuil2 contenant la valeur a rechercher et son code couleur.

Exemple en pièce jointe

Merci d'avance

 

[Dranreb]

Bonsoir.

Cette procédure fait le boulot :

Sub ColorerTypes()
Dim T(), L&, TSpl() As String, D As New Scripting.Dictionary, PlgLst As Range, Code
T = Feuil1.ListObjects("Tab_Catégorie").DataBodyRange.Value
For L = 1 To UBound(T)
   TSpl = Split(T(L, 2), ",")
   D.Add T(L, 1), RGB(TSpl(0), TSpl(1), TSpl(2))
   Next L
Set PlgLst = Feuil1.ListObjects("Tab_Liste").DataBodyRange
For L = 1 To PlgLst.Rows.Count
   Code = PlgLst(L, 2).Value
   If D.Exists(Code) Then PlgLst(L, 1).Interior.Color = D(Code)
   Next L
End Sub

Important: Cochez la référence Microsoft Scripting Runtime

 

[Meosus]

Merci,

par contre tu coche ou la référence Microsoft Scripting Runtime?

 

[Dranreb]

Dans VBA, menu Outils, Références…

 

[Meosus]

Super,
Merci beaucoup!

 

[mapomme]

Bonjour à tous,

Comme j'avais commencé, je publie : même solution que Dranreb que je salue 🙂

Sub colorier()
Dim dico, Couleurs(), i&, aux, xcell As Range

   Set dico = CreateObject("scripting.dictionary")
   dico.comparemode = vbTextCompare
   Couleurs = Range("Tab_Catégorie[[Catégorie]:[RGB]]")
   For i = LBound(Couleurs) To UBound(Couleurs)
      aux = Split(Couleurs(i, 2), ",")
      dico(Couleurs(i, 1)) = RGB(aux(0), aux(1), aux(2))
   Next i
   Application.ScreenUpdating = False
   Range("Tab_Liste[[Code]]").Interior.ColorIndex = xlColorIndexNone
   For Each xcell In Range("Tab_Liste[[Code]]")
      If dico.exists(xcell.Offset(, 1).Value) Then _
         xcell.Interior.Color = dico(xcell.Offset(, 1).Value)
   Next xcell
End Sub