Mise en couleur de cellules

amandeine · 23 Juin 2013

Bonjour !

Je cherche de l’aide pour créer une fonction qui permet de colorier des cellules correspondant à des valeurs.

J’ai essayé avec la fonction « mise en forme conditionnelle » mais malheureusement, je n’y arrive pas ou que partiellement. Mes compétences sont relativement limitées à l’emploi des fonctions de base d'excel.

C’est pourquoi je m’adresse à vous pour me fournir une aide, dont je remercie d’avance toute contribution.

Pour expliquer mon besoin, j’ai joint un fichier et ma demande est celle-ci :

Je voudrais mettre en couleur sur la colonne allant de C18 à C 1751 toutes les cellules qui correspondent à la valeur se trouvant dans la cellule C6 et de sa couleur et faire la même chose avec :
la valeur C7 et sa couleur,
la valeur C8 et sa couleur,
la valeur C9 et sa couleur,
la valeur C10 et sa couleur
la valeur C11 et sa couleur
la valeur C12 et sa couleur

ET colorier les cellules allant de C18 à C1751 ayant une valeur se trouvant dans les cellules 1757 à 1780 avec la couleur grise.

Lorsqu’une cellule (C 6 à C 12 et C 1757 à C 1780) est vide (sans valeur), ne pas prendre en compte.

Appliquer le même principe à chacune des colonnes qui se suivent.

Je voudrais avoir la possibilité d’appliquer le principe à de nouvelles colonnes qui n’existent pas encore et au fur à mesure qu’elles seront crées à partir de la colonne D.

Merci d’avance pour toute aide.

JBARBE · 24 Juin 2013

Re : Mise en couleur de cellules

La coloration est un peu longue ( sablier) mais le tableau est important !! Patience il n'y a pas d'autre solution pour que cela soit plus rapide ( à moins de réduire le tableau ):

Les explications de la macro sont spécifiés !

Code:

Sub Colorier_1()
Dim k As Integer
Dim i As Integer
Dim j As Integer
Sheets("Feuil1").Activate
Range("C18:AD1751").Interior.ColorIndex = xlNone
For k = 3 To 28 ' selection des colonnes de la colonne 3 (C) à la colonne 28(AD)
 For i = 1757 To 1780 ' Prise en compte des valeurs des lignes 1757 à 1780
  If Cells(i, k) = 12 Or Cells(i, k) = 8 Or Cells(i, k) = 7 Or Cells(i, k) = 13 _
  Or Cells(i, k) = 20 Or Cells(i, k) = 1 Or Cells(i, k) = 4 Then
   For j = 18 To 1751 ' Coloriage définitif des cellules C18 à AD1751 en fonction des valeurs numérotées
  If Cells(j, k) = 12 And Cells(j, k) = Cells(i, k) Then Cells(j, k).Interior.ColorIndex = 43
  If Cells(j, k) = 8 And Cells(j, k) = Cells(i, k) Then Cells(j, k).Interior.ColorIndex = 6
  If Cells(j, k) = 7 And Cells(j, k) = Cells(i, k) Then Cells(j, k).Interior.ColorIndex = 6
  If Cells(j, k) = 13 And Cells(j, k) = Cells(i, k) Then Cells(j, k).Interior.ColorIndex = 44
  If Cells(j, k) = 20 And Cells(j, k) = Cells(i, k) Then Cells(j, k).Interior.ColorIndex = 33
  If Cells(j, k) = 1 And Cells(j, k) = Cells(i, k) Then Cells(j, k).Interior.ColorIndex = 15
  If Cells(j, k) = 4 And Cells(j, k) = Cells(i, k) Then Cells(j, k).Interior.ColorIndex = 15
 Next j
  End If
 Next i
 Next k
End Sub

JBARBE · 24 Juin 2013

Re : Mise en couleur de cellules

Autre possibilité signalée par Chris :

NOTA : le coloriage est trés trés long ( patience) il a beaucoup de coloriage à faire !

N'oublions pas que cela doit s’affecter pour chaque colonne !

Code:

Sub Colorier_1()
Dim k As Integer
Dim i As Integer
Dim j As Integer
Sheets("Feuil1").Activate
Range("C18:AD1751").Interior.ColorIndex = xlNone ' effacement des couleurs
For k = 3 To 28 ' sélection des colonnes de la colonne 3 (C) à la colonne 28(AD)
 For i = 1757 To 1780 ' Prise en compte des valeurs des lignes 1757 à 1780
  If Cells(i, k) > 0 Then
   For j = 18 To 1751 ' Coloriage définitif des cellules C18 à AD1751 en tenant compte de toutes les valeurs
  If Cells(j, k) = 12 And Cells(j, k) = Cells(i, k) Then
  Cells(j, k).Interior.ColorIndex = 43
  ElseIf Cells(j, k) = 8 And Cells(j, k) = Cells(i, k) Then
  Cells(j, k).Interior.ColorIndex = 6
  ElseIf Cells(j, k) = 7 And Cells(j, k) = Cells(i, k) Then
  Cells(j, k).Interior.ColorIndex = 6
  ElseIf Cells(j, k) = 13 And Cells(j, k) = Cells(i, k) Then
  Cells(j, k).Interior.ColorIndex = 44
  ElseIf Cells(j, k) = 20 And Cells(j, k) = Cells(i, k) Then
  Cells(j, k).Interior.ColorIndex = 33
  ElseIf Cells(j, k) = 1 And Cells(j, k) = Cells(i, k) Then
  Cells(j, k).Interior.ColorIndex = 15
  ElseIf Cells(j, k) = 4 And Cells(j, k) = Cells(i, k) Then
  Cells(j, k).Interior.ColorIndex = 15
  ElseIf Cells(j, k) <> "" And Cells(j, k) = Cells(i, k) Then
  Cells(j, k).Interior.ColorIndex = 47
  End If
 Next j
  End If
 Next i
 Next k
End Sub

amandeine · 24 Juin 2013

Re : Mise en couleur de cellules

Juste un petit coucou vite fait pour dire de ne pas perdre de temps à continuer à travailler dessus, car de ce que j'ai vu des derniers fichiers, cela ne correspond pas à la demande formulée, peut-être mal expliquée.

je repasserai plus tard (car là, je travaille ) pour expliquer plus précisément ce qui ne va pas !

encore merci

amandeine · 24 Juin 2013

Re : Mise en couleur de cellules

Juste un petit coucou vite fait pour dire de ne pas perdre de temps à continuer à travailler dessus, car de ce que j'ai vu des derniers fichiers, cela ne correspond pas à la demande formulée, peut-être mal expliquée.

je repasserai plus tard (car là, je travaille ) pour expliquer plus précisément ce qui ne va pas !

encore merci

JBARBE · 24 Juin 2013

Re : Mise en couleur de cellules

Bonjour,

J’avoue ( pardons nous avouons que nous avons rien compris, Chris, moi et tout ceux qui sont prêts à t'aider) !!

Le plus simple est d'envoyer un fichier avec les couleurs souhaitées manuellement dans quelques lignes et sur une colonne avec les valeurs adéquates ( nous comprendrons mieux) !

Bonne journée !

Mise en couleur de cellules

amandeine

XLDnaute Nouveau

Pièces jointes

JBARBE

XLDnaute Barbatruc

Pièces jointes

JBARBE

XLDnaute Barbatruc

Pièces jointes

amandeine

XLDnaute Nouveau

amandeine

XLDnaute Nouveau

JBARBE

XLDnaute Barbatruc

Discussions similaires