XL 2013 changement de couleur de cellules si depassement de temps

[zergo]

bonjour le forum.

j'ai un petit dilemme sur Excel, comment faire une macro pour changer plusieurs cellules dans une colonne de plus de 2500 lignes de couleurs en fonction d un dépassement de temps par rapport à des critères .

Exemple:

de 15h00 à 23h59 couleur jaune
de 24h00 à 47h59 couleur orange
de 48h00 et plus rouge.

merci

cordialement

 

[fanfan38]

Bonjour
En l'absence de fichier...
Boucle pour mettre les couleurs dans la colonne 1

Sub couleur()
Dim i As Long, derlig As Long
derlig = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To derlig
   Select Case Cells(i, 1).Value
     Case 0.625 To 0.999305556
       Cells(i, 1).Interior.ColorIndex = 6
     Case 1 To 1.999305556
       Cells(i, 1).Interior.ColorIndex = 45
     Case Is > 1.999305556
       Cells(i, 1).Interior.ColorIndex = 3
     Case Else
       Cells(i, 1).Interior.ColorIndex = 0
   End Select
Next
End Sub

pour modif lors de la saisie

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Long
  If Target.Column > 1 Then Exit Sub
  i = Target.Row
   Select Case Cells(i, 1).Value
     Case 0.625 To 0.999305556
       Cells(i, 1).Interior.ColorIndex = 6
     Case 1 To 1.999305556
       Cells(i, 1).Interior.ColorIndex = 45
     Case Is > 1.999305556
       Cells(i, 1).Interior.ColorIndex = 3
     Case Else
       Cells(i, 1).Interior.ColorIndex = 0
   End Select
End Sub

A+ François

 

[zergo]

Bonjour
Merci pour la macro.
c'est tout à fait impeccable il me reset à l' adapter à mon fichier.

Merci

 

[zergo]

Bonjour
Merci pour la macro.
c'est tout à fait impeccable il me reset à l' adapter à mon fichier.

Merci

Une petite question.

comment convertir le texte en rouge

Case 0.625 To 0.999305556
Cells(i, 6).Interior.ColorIndex = 6
Case 1 To 1.999305556
Cells(i, 6).Interior.ColorIndex = 45
Case Is > 1.999305556


Merci

 

[zergo]

Bonjour
En l'absence de fichier...
Boucle pour mettre les couleurs dans la colonne 1

Sub couleur()
Dim i As Long, derlig As Long
derlig = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To derlig
   Select Case Cells(i, 1).Value
     Case 0.625 To 0.999305556
       Cells(i, 1).Interior.ColorIndex = 6
     Case 1 To 1.999305556
       Cells(i, 1).Interior.ColorIndex = 45
     Case Is > 1.999305556
       Cells(i, 1).Interior.ColorIndex = 3
     Case Else
       Cells(i, 1).Interior.ColorIndex = 0
   End Select
Next
End Sub

pour modif lors de la saisie

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Long
  If Target.Column > 1 Then Exit Sub
  i = Target.Row
   Select Case Cells(i, 1).Value
     Case 0.625 To 0.999305556
       Cells(i, 1).Interior.ColorIndex = 6
     Case 1 To 1.999305556
       Cells(i, 1).Interior.ColorIndex = 45
     Case Is > 1.999305556
       Cells(i, 1).Interior.ColorIndex = 3
     Case Else
       Cells(i, 1).Interior.ColorIndex = 0
   End Select
End Sub

A+ François

Rebonjour
si je souhaite affecter la macro a une colonne AB par exemple ou à un ensemble de colonnes AB à AD.

que doit ton modifier.

Merci

 

[fanfan38]

Case Cells(i, 1).Value i est la ligne 1 est la colonne. donc pour AB remplacer 1 par 28....
Ne pas oublier de modifier Target.Column > 1 qui pour AB sera
If Target.Column <28 or Target.Column > 28 ...
pour AB/AD If Target.Column <28 or Target.Column > 30 ...
Dans ce cas il faudra aussi ajouter des lignes:
cells(i, 29).Interior.ColorIndex = 6
cells(i, 30).Interior.ColorIndex = 6
Pour mettre le texte en rouge
cells(i, 1).font.ColorIndex = 3

A+ François

 

[zergo]

Bonjour

Merci pour l'explication