Problème avec Mergecells

Bonjour le forum,

je n'arrive pas à transcrire ce que je veux faire :
j'ai un tableau avec des dates colonnes F et des numéros de dossier colonne G
si j'ai plusieurs dates pour un meme dossier, G est fusionné

je veux comparer les dates en F par rapport à la date du jour. Si la date est dépassé, je mets une couleur, jusque là tout va bien.
Si G est fusionné (par exemple G10 et G11 fusionnés), j'ai donc une date en F10 et une en F11.
=>Si F10 est dépassé, je mets une couleur, si F11 n'est pas dépassé je laisse tel quel.
=> Si F10 est dépassé, je mets une couleur, si F11 est dépassé, je mets une couleur différente de F10
=> si aucune date n'est dépassé je ne touche à rien

Voilà le début de mon code :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35

Sub Couleurs()   Dim plage As Range, cell As Range Dim DerLigne As Long Dim LigDate As Date   DerLigne = Range("A65536").End(xlUp).Row Set plage = Range("F10:F" & DerLigne)   Range("f10").Select For Each cell In plage LigDate = ActiveCell If cell.Offset(0, 2).MergeCells Then If Date > LigDate Then cell.Interior.Color = RGB(125, 147, 99) cell.Offset(0, -1).Interior.Color = RGB(125, 147, 99) cell.Offset(0, -2).Interior.Color = RGB(125, 147, 99) cell.Font.Color = RGB(255, 255, 255) cell.Offset(0, -1).Font.Color = RGB(255, 255, 255) cell.Offset(0, -2).Font.Color = RGB(255, 255, 255) End If Else: LigDate = ActiveCell If Date > LigDate Then cell.Interior.Color = RGB(127, 127, 127) cell.Offset(0, -1).Interior.Color = RGB(127, 127, 127) cell.Offset(0, -2).Interior.Color = RGB(127, 127, 127) cell.Font.Color = RGB(255, 255, 255) cell.Offset(0, -1).Font.Color = RGB(255, 255, 255) cell.Offset(0, -2).Font.Color = RGB(255, 255, 255) End If End If ActiveCell.Offset(1, 0).Select Next cell End Sub

---

le problème est que là, je n'arrive pas, si F10 et F11 sont dépassées, à mettre des couleurs différentes à F10 et F11...
d'autant que pour un autre dossier, G12 et G13 peuvent aussi être fusionnés, et là je me perds...

J'ai besoin d'un peu d'aide svp :oops:

Bonjour,

Contrairement à tes explications, tu as l'air de colorier les cellules des colonnes D et E. Peux-tu préciser ?

Bonjour Daniel,

effectivement je colorie D, E et F

Code:

---

Range("F10").select

---

et

Code:

---

1 2 3

cell.Interior.Color = RGB(125, 147, 99) cell.Offset(0, -1).Interior.Color = RGB(125, 147, 99) cell.Offset(0, -2).Interior.Color = RGB(125, 147, 99)

---

J'ai mis uniquement F parce que je pense pouvoir adapter avec D et E (enfin j'espere ;))

Et deuxième erreur de ma part, c'est la colonne H et non G qui voit des cellules fusionnées... :oops:

pour résumer :
Si H n'est pas fusionné, vérifier si la date en F est terminé, si oui la colorié avec

Code:

---

RGB(127,127,127)

---

si H10 et H11 sont fusionnés, je veux vérifier si la date en F10 est dépassée, si oui la coloriée avec

Code:

---

RGB(125, 147, 99)

---

, et si on vient de colorier F10, vérifier si F11 est terminé, et si oui la colorier à son tour avec

Code:

---

RGB(127,127,127)

---

...

le tout sur un fichier de 10 000 lignes...

Essaie comme ça; je ne me suis occupé que de la colonne F. Quant aux dates, je les ai comparées avec la date du jour.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

Sub Couleurs()   Dim Plage As Range, cell As Range Dim DerLigne As Long Dim LigDate As Date   DerLigne = Range("A65536").End(xlUp).Row Set Plage = Range("F10:F" & DerLigne)   For Each cell In Plage If cell.Offset(0, 2).MergeCells Then 'si c'ests bien la colonne H... If cell < Date And cell.Offset(, 2) <> "" Then cell.Interior.Color = RGB(125, 147, 99) End If If cell < Date And cell.Offset(, 2) <> "" And cell.Offset(1) < Date Then cell.Offset(1).Interior.Color = RGB(127, 127, 127) End If Else If cell < Date Then cell.Interior.Color = RGB(127, 127, 127) End If End If Next cell End Sub

---

Merci Daniel, ça fonctionne parfaitement. J'ai juste adapté avec les colonnes D et E et c'est parfait!

Encore Merci !!! :ccool: