Public Sub Macro1()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dico As Object 'déclare la variable dico (DICtiOnnaire)
Dim cel As Range 'déclare la variable cel (CELLule)
Dim temp As Variant 'déclare la variable temp (tableau TEMPoraire)
Dim i As Integer 'déclare la variable i (Incrément)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim dd As Date 'déclare la variable dd (Date de Début)
Dim df As String 'déclare la variable df (Date de Fin)
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
With Sheets("lrship 09 cust") 'prend en compte l'onglet "lrship 09 cust"
.Columns(8).Interior.ColorIndex = xlNone 'supprime la couleur rouge
dl = .Cells(Application.Rows.Count, 4).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 4 (=D)
Set pl = .Range("D2:D" & dl) 'définit la plage pl
Set dico = CreateObject("Scripting.Dictionary") 'e'finit la dictionnaire dico
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
dico(cel.Value) = "" 'alimente le dictionnaire dico
Next cel 'prochaine cellule de la boucle
temp = dico.keys 'récupère le dictionnnaire dico sans doublons dans le tableau temporaire temp
For i = 0 To UBound(temp, 1) 'boucle sur tous les éléments uniques du tableau temp
Set r = pl.Find(temp(i), .Cells(dl, 4), xlValues, xlWhole) 'définit la recherche r
If Not r Is Nothing Then 'condition 1 : si il il existe au moins une occurrence trouvée
pa = r.Address 'définit l'adresse dela première occurrence
dd = r.Offset(0, 4).Value 'récupère la date de début
r.Offset(0, 4).Interior.ColorIndex = 3 'colore la date de début de rouge
Do 'exécute
If r.Offset(0, 4).Value < dd + 365 Then 'condition 2 : si la date de l'occurrence trouvée est inférieure à la date de début + 365 jours
df = r.Offset(0, 4).Value 'définit la date de fin
r.Offset(0, 4).Interior.ColorIndex = 3 'colore la date de l'occurrence trouvée de rouge
Else 'sinon (condition 2)
Exit Do 'sort de la boucle do... Loop
End If 'fin de la condition 2
Set r = pl.FindNext(r) 'redéfinit la recherche r (occurrence suivante)
Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe de nouvelles ouccurrences ailleurs qu'en pa
End If 'fin de la condition 1
Next i 'prochain élément de la boucle
End With 'fin de la prise en compte de l'onglet "lrship 09 cust"
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Les données ont été traitées avec succès !" 'meesage de fin
End Sub