XL 2013 Rechercher et mettre en surbrillance des doublons (ou chevauchement)

Option Explicit

Const InterPoste = 15      ' durée minimale entre la libération d'un poste
                           ' et la prise en main d'un autre poste
                           ' la durée est exprimée en minute.

Sub Reperer_Doublon()
Const Source = "Feuil1"
Dim derlig&, dercol&, t, i&, ii&, j&, jj&, nomOp$

Application.ScreenUpdating = False
' lecture des données - tableau t
Worksheets(Source).Select
derlig = Cells(Rows.Count, "b").End(xlUp).Row + 1  '(une ligne en plus !!! )
dercol = Cells(1, Columns.Count).End(xlToLeft).Column + 4
t = Range("a1").Resize(derlig, dercol).Value

'on "décolore les données sources"
Range("a2").Resize(derlig, dercol).Interior.ColorIndex = xlColorIndexNone
Range("a2").Resize(derlig, dercol).Font.Color = vbBlack

' dans le tableau, on normalise les noms (minuscule)
' et on ajoute la date aux heures [heure  <- date + heure]
For i = 3 To UBound(t)
   For j = 5 To UBound(t, 2) Step 5
      t(i, j - 2) = Trim(LCase(t(i, j - 2)))    'normalisation du nom
      If t(i, j - 2) <> "" And t(i, j) <> "" And t(i, j + 2) <> "" Then
         'nom et horaires non vides, on continue
         If IsDate(t(i, 2)) And IsNumeric(t(i, j)) And IsNumeric(t(i, j + 2)) Then
            ' à priori la date et l'horaire de début et de fin existent
            ' on va rajouter la date aux heures
            If t(i, j + 2) >= t(i, j) Then
               'l'heure de fin est supérieure ou égale à l'heure de début (même jour)
               t(i, j) = t(i, 2) + t(i, j)
               t(i, j + 2) = t(i, 2) + t(i, j + 2)
            Else
               ' l'heure de fin est inférieure à l'heure de début
               '  on rajoute un jour à l'heure de fin
               t(i, j) = t(i, 2) + t(i, j)
               t(i, j + 2) = t(i, 2) + 1 + t(i, j + 2)
            End If
         Else
            'date ou horaires incorrects, le nom est mis à vide
            t(i, j - 2) = Empty
         End If
      Else
         'date ou horaires incorrects, le nom est mis à vide
         t(i, j - 2) = Empty
      End If
   Next j
Next i
'on vide la dernière ligne
For j = 1 To UBound(t, 2): t(UBound(t), j) = Empty: Next

' pour chaque plage d'une ligne, on regarde si l'opérateur correspondant
' n'a pas une autre plage qui la chevauche. (on regarde dans la ligne plus la suivante)
For i = 3 To UBound(t) - 1
   For j = 5 To UBound(t, 2) Step 5
      nomOp = t(i, j - 2)
      If nomOp <> "" Then        'le nom de l'opérateur ne doit pas être vide
         'on regarde les autres plages du même opérateur en excluant la plage en cours
         For ii = i To i + 1
            For jj = 5 To UBound(t, 2) Step 5
               ' on exclut la plage de référence en cours de l'opérateur
               ' les noms doivent être identiques
               If Not (ii = i And jj = j) And t(ii, jj - 2) = nomOp Then
                  If Chevauchement(t(i, j), t(i, j + 2), t(ii, jj), t(ii, jj + 2), InterPoste) Then
                     Range(Cells(i, j - 2), Cells(i, j + 2)).Interior.Color = vbYellow
                     Range(Cells(i, j - 2), Cells(i, j + 2)).Font.Color = vbRed
                     Range(Cells(ii, jj - 2), Cells(ii, jj + 2)).Interior.Color = vbYellow
                     Range(Cells(ii, jj - 2), Cells(ii, jj + 2)).Font.Color = vbRed
                  End If
               End If
            Next jj
         Next ii
      End If
   Next j
Next i
End Sub

Function Chevauchement(x0, y0, x1, y1, DureeInterPoste) As Boolean
Dim interv0, interv1
   'interv0 est la plage dont le début est le plus petit
   If x0 <= x1 Then
      interv0 = Array(x0, y0): interv1 = Array(x1, y1)
   Else
      interv0 = Array(x1, y1): interv1 = Array(x0, y0)
   End If
   'on tient compte de la durée entre deux postes
   Chevauchement = interv1(0) < interv0(1) + DureeInterPoste / 1440
End Function