Couleur De Fond

JU555

XLDnaute Occasionnel
Bonjour à toutes et à tous et un tout bon week-end à vous !

Voilà ma question :

Je souhaiterais qu'une couleur de fond soit appliquée à une série de cellules en fonction de la valeur de ces cellules par rapport à d'autres.

Ainsi, dans le fichier joint, les cellules de la plage B4 à K25 recevraient la couleur de fond de la cellule de la plage B27 à G38.

Exemple : C4 se verra appliquer la couleur de fond bleu clair présente en C28 MAIS pas la couleur de fond jaune en B29, car B28 est "avant" B29.

Je souhaiterais également, dans la plage L4:L25 pouvoir sommer le nombre de cellules qui ont reçu une couleur de fond, donc qui n'ont pas un fond blanc.

J'ai des idées, mais rien de vraiment automatisé, ou alors trop tordu pour arriver à un résultat convenable.

Merci pour votre aide !
 

Pièces jointes

  • Prob 1.1.xls
    16 KB · Affichages: 69
  • Prob 1.1.xls
    16 KB · Affichages: 66
  • Prob 1.1.xls
    16 KB · Affichages: 67

JU555

XLDnaute Occasionnel
Re : Couleur De Fond

Par contre, je me sers de votre code pour faire la même chose et simulanément sur une autre plage. Ca marche mais c'est très lent et je ne sais pas pourquoi.

MERCI !!
 

Pièces jointes

  • Prob 1.1-1.xls
    29 KB · Affichages: 61

jeanpierre

Nous a quitté
Repose en paix
Re : Couleur De Fond

Bonsoir JU555, Pierrot, skoobi, et JP,

Oui c'est lent, voire même très très long.... je viens de tester, un peu galère...

Mais il faut savoir ce que l'on veut.. VBA c'est bien, mais il lui faut le temps de travailler... (on veut, mais on impose pas)

Voilà...

Jean-Pierre
 

Pierrot93

XLDnaute Barbatruc
Re : Couleur De Fond

Re

essaye comme ci dessous :

Code:
Sub test()
Dim p1 As Range, p2 As Range, c1 As Range, c2 As Range, c3 As Range, p3 As Range, masomme As Integer
Application.ScreenUpdating = False

For Each c1 In Range("B4:K25")
    For Each c2 In Range("B27:G38")
        For Each c3 In Range("B40:K44")
            If c1.Value = c2.Value Then c1.Interior.ColorIndex = c2.Interior.ColorIndex: Exit For
            If c3.Value = c2.Value Then c3.Interior.ColorIndex = c2.Interior.ColorIndex: Exit For
        Next c3
    Next c2
Next c1
For Each c1 In Range("L4:L25")
    masomme = 0
    For Each c2 In Range(c1.Offset(0, -10), c1.Offset(0, -1))
        If c2.Interior.ColorIndex <> xlNone Then masomme = masomme + 1
    Next c2
    c1.Value = masomme
Next c1
Application.ScreenUpdating = True
End Sub

gagnera un peu en exécution.

@+
 

Pierrot93

XLDnaute Barbatruc
Re : Couleur De Fond

Bonjour Ju, jp14, Jean-Pierre, Skoobi

en une seule boucle, si j'ai bien compris.... un poil moins rapide que jp:), mais bon...

Code:
Sub test()
Dim c1 As Range, x As Range
Application.ScreenUpdating = False
Range("L4:L44").ClearContents
For Each c1 In Range("B4:K25,B40:K44")
    Set x = Range("B27:G38").Find(c1.Value, , xlValues, xlWhole, xlByRows, , False)
    If Not x Is Nothing Then c1.Interior.ColorIndex = x.Interior.ColorIndex: Set x = Nothing: Range("L" & c1.Row).Value = Range("L" & c1.Row).Value + c1.Value
Next c1
Application.ScreenUpdating = True
End Sub

bon dimanche
@+
 

Discussions similaires

Réponses
16
Affichages
471

Statistiques des forums

Discussions
313 090
Messages
2 095 172
Membres
106 199
dernier inscrit
freeman74