donner une valeur en fonction de la couleur de la cellule

[pascal21]

bonjour à tous
je cherche le moyen de donner une valeur à des cellules (zone c17:y32) en fonction de leur couleur de fond
ces valeurs sont issues d'une liste
j'ai vu un peu partout que l'on peut donner une couleur en fonction d'une valeur en vba mais pas le contraire
voici les codes couleurs que j'utilise et leurs valeurs

6 Mach.1
33 mach.2
12 mach3
23 mach4
43 mach5
15 mach6
3 mach7
36 mach8
46 mach9
35 mach10

j'ai crée une liste avec les couleurs et le contenu à afficher nommée ListeCouleurs
cette liste est appelée à évoluée tant en nombre de couleurs que les valeurs qu'elle contient
merci de votre aide

 

[pierrejean]

Re : donner une valeur en fonction de la couleur de la cellule

Re

Tu peux t'inspirer de ceci

tablo = Range("Listecouleurs")
For Each cel In Range("H7:J16")
  For n = LBound(tablo, 1) To UBound(tablo, 1)
    If cel.Interior.ColorIndex = tablo(n, 1) Then cel.Value = tablo(n, 2)
  Next
Next

 

[pascal21]

Re : donner une valeur en fonction de la couleur de la cellule

re
bon là je n'arrive pas à faire fonctionner ce code
j'ai essayé de modifier quelques éléments (la zone et le nom de la liste (majuscules)) et d'autres, pensant à une éventuelle faute de frappe mais que neni

 

[pierrejean]

Re : donner une valeur en fonction de la couleur de la cellule

Re

Tu fais le petit effort qui consiste à créer un petit fichier exemple et on réglera cela

 

[pascal21]

Re : donner une valeur en fonction de la couleur de la cellule

re
aussitôt demandé aussitôt fait

 

[pierrejean]

Re : donner une valeur en fonction de la couleur de la cellule

Re

Voila
Selon le #1 j'avais interprété ton tableau comme ayant 2 colonnes !!

 

[Dull]

Re : donner une valeur en fonction de la couleur de la cellule

Salut pascal, PierreJean, le Forum

Histoire de saluer mon ami Pierre une petite amélioration qui te permettras d’inscrire les valeurs QUE dans les tableaux avec bordures... Commentça...mafainéantisemeperdra...

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim cel As Range
For Each cel In Range("b17:y32")
  For Each cell In Sheets("feuil2").Range("listeCouleurs")
    If cel.Interior.ColorIndex = cell.Interior.ColorIndex And cel.Borders(xlEdgeTop).LineStyle <> xlNone Then cel.Value = cell.Value
    If cel.Borders(xlEdgeTop).LineStyle = xlNone Then cel.Interior.ColorIndex = xlNone
  Next
Next
Application.ScreenUpdating = True
End Sub

Bon Week-end à Tous

 

[mapomme]

Re : donner une valeur en fonction de la couleur de la cellule

Bonjour pascal21 , pierrejean , Dull

Une méthode quelque peu différente qui est plutôt rapide sur des zones comprenant de nombreuses cellules. On utilise la fonction replace en recherchant un format (tour à tour celui de chaque cellule de la zone "listeCouleurs"). On se limite à la recherche de la couleur de fond mais rien n'empêche de rajouter d'autres contraintes (encadrement, police...). Du coup, il n'y a plus qu'une seule boucle sur la zone "listeCouleurs".

Le code:

Sub Remplacer_selon_fond()
Dim comme As Range, T
  T = Timer
  Application.ScreenUpdating = False
  For Each comme In Sheets("feuil2").Range("listeCouleurs")
    Application.ReplaceFormat.Clear
    Application.FindFormat.Clear
    With Application.FindFormat.Interior
      .Pattern = comme.Interior.Pattern
      .PatternColorIndex = comme.Interior.PatternColorIndex
      .Color = comme.Interior.Color
      .TintAndShade = comme.Interior.TintAndShade
      .PatternTintAndShade = comme.Interior.PatternTintAndShade
    End With
    Sheets("feuil1").Range("b17:x1035").Cells.Replace What:="", _
      Replacement:=comme.Value, LookAt:=xlWhole, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
      ReplaceFormat:=False
  Next comme
  Application.ScreenUpdating = True
  MsgBox (Timer - T)
End Sub

nb: Je salue pierrejean , Dull

 

[pascal21]

Re : donner une valeur en fonction de la couleur de la cellule

bonjour àtous et merci pour vos réponses
j'ai opté pour la solution de pierreJean ce n'est pas très rapide mais ça fonctionne
Dull merci mais je n'ai pas vu ce que ça apportait de plus
mapomme sur mon classeur ça ne fonctionne pas, ça m'a même mis le bazar dans les cellules, pas compris pourquoi
bon dimanche !!!

 

[pierrejean]

Re : donner une valeur en fonction de la couleur de la cellule

Re

Tu peux accélérer un peu avec

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
For Each cel In Range("b17:y32")
  For Each cell In Sheets("feuil2").Range("listeCouleurs")
    If cel.Interior.ColorIndex = cell.Interior.ColorIndex Then cel.Value = cell.Value
  Next
Next
Application.ScreenUpdating = True
End Sub

 

[ChTi160]

Re : donner une valeur en fonction de la couleur de la cellule

Bonjour pascal21
Bonjour le fil
Bonjour le forum

en pièce jointe une autre approche

Le Fichier : Regarde la pièce jointe listecouleurs(2).xls

pour ma part la procédure de mapomme fonctionne très bien et même de façon très rapide !!! (plus rapide que la mienne)

Bonne journée
Amicalement
Jean Marie

 

[pierrejean]

Re : donner une valeur en fonction de la couleur de la cellule

Re

Une autre version plus rapide que ma précédente macro

Set dico = CreateObject("Scripting.dictionary")
For Each cel In Range("listeCouleurs")
 dico(cel.Interior.Color) = cel.Value
Next
Application.ScreenUpdating = False
For Each cel In Range("b17:y32")
  cel.Value = dico(cel.Interior.Color)
Next
Application.ScreenUpdating = True