Macro de détection de cellules non vides consécutives

Function Alerte$(Message$, Gauche!, Haut!, Optional Activer As Boolean = True, Optional Inclinaison!, Optional CouleurFond& = 16777215, Optional CouleurTexte&, Optional Graisse As Boolean, Optional Transparence#)
    If Len(Message) Then
        On Error GoTo E
        With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Gauche, Haut, 20, 20)
            On Error Resume Next
            With .TextFrame
                With .Characters
                    .Text = Message
                    With .Font
                        .Color = CouleurTexte
                        .Bold = Graisse
                    End With
                End With
                .AutoSize = msoAutoSizeShapeToFitText
            End With
            With .Fill
                .ForeColor.RGB = CouleurFond
                .Transparency = Transparence
            End With
            .IncrementRotation -Inclinaison
            If Activer Then .Select
            Alerte = .Name
            On Error GoTo 0
        End With
    End If
R:
Exit Function
E:  Alerte = "-1"
    Resume R
End Function

Sub VerificationLateEarly()
Dim Pers(), CritC(), plg As Range, plgR(), refDate$
Dim i&, j&, k&, p&, d&, VF As Boolean
Dim Crit0$, Crit1$
Dim ep$, msg$
    CritC = Array("LT", "EY")
    With Worksheets("Paramètres")
        On Error GoTo E1
        Pers = .[A1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row).Value
        On Error GoTo 0
        refDate = .[C2].Value
    End With
    With Worksheets("Cycle Planning")
        On Error GoTo E1
        plgR = .Range("DATA").Value
        On Error GoTo 0
    End With
    For p = 2 To UBound(Pers, 1)
        If Not IsEmpty(Pers(p, 1)) Then
            ep = Pers(p, 1)
            For d = 1 To UBound(plgR, 1)
                If plgR(d, 1) = refDate Then
                    For i = d + 1 To UBound(plgR, 1)
                        If plgR(i, 1) = ep Then
                            For j = 2 To UBound(plgR, 2)
                                Crit0 = Crit1: Crit1 = plgR(i, j)
                                If Crit0 = CritC(0) And Crit1 = CritC(1) Then
                                    msg = msg & IIf(VF, "", ep & " :" & vbLf) & Space(12) & CritC(0) & " - " & CritC(1) & "   ( " & Format(plgR(d, j) - 1, "ddd dd/mm/yy") & " - " & Format(plgR(d, j), "ddd dd/mm/yy") & " )" & vbLf
                                    VF = True
                                End If
                            Next
                        ElseIf plgR(i, 1) = refDate Or IsEmpty(plgR(i, 1)) Then
                            Exit For
                        End If
                    Next
                End If
            Next
            If VF Then msg = msg & vbLf
            VF = False
            Crit1 = ""
        End If
    Next
    If Len(msg) Then msg = vbLf & Left$(msg, Len(msg) - 1)
   Call Alerte(Message:=msg, Gauche:=90, Haut:=45, Largeur:=240, Activer:=True, Inclinaison:=5, CouleurFond:=RGB(255, 255, 64), CouleurTexte:=0, Graisse:=False, Transparence:=0.12)
Exit Sub
'Gestionnaire d'erreurs de lecture des paramètres :
E1:
    MsgBox "Aucun contrôle à faire." 'Parce que la liste du
'personnel est vide et/ou il n'y a pas de données à traiter.
    End
End Sub

Sub Vérification_Astreinte()
Dim Pers(), CritC(), plg As Range, plgR(), refDate$
Dim i&, j&, k&, l&, m&, n&, p&, d&, VF As Boolean, VF2 As Boolean
Dim ep$, msg$
  CritC = Array(Array("WE", "WL", "Off", "Vac"), Array("AstrW", "Astr"))
  With Worksheets("Paramètres")
    On Error GoTo E1
    Pers = .[A1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row).Value
    On Error GoTo 0
    refDate = .[C2].Value
  End With
  With Worksheets("Cycle Planning")
    On Error GoTo E1
    plgR = .Range("DATA").Value
    On Error GoTo 0
  End With
  For p = 2 To UBound(Pers, 1)
    If Not IsEmpty(Pers(p, 1)) Then
      ep = Pers(p, 1)
      For d = 1 To UBound(plgR, 1)
        If plgR(d, 1) = refDate Then
          For i = d + 1 To UBound(plgR, 1)
            If plgR(i, 1) = ep Then
              VF2 = False
              For l = i + 1 To UBound(plgR, 1)
                If plgR(l, 1) = ep Then
                  VF2 = True: Exit For
                ElseIf plgR(i, 1) = refDate Then
                  VF2 = False: Exit For
                End If
              Next
              If VF2 Then
                For j = 2 To UBound(plgR, 2)
                  VF2 = False
                  For m = 0 To UBound(CritC(0))
                    If plgR(i, j) = CritC(0)(m) Then VF2 = True: Exit For
                  Next
                  If VF2 Then
                    VF2 = False
                    For n = 0 To UBound(CritC(1))
                      If plgR(l, j) = CritC(1)(n) Then VF2 = True: Exit For
                    Next
                    If VF2 Then
                      msg = msg & IIf(VF, "", ep & " :" & vbLf) & Space(12) & CritC(0)(m) & " - " & CritC(1)(n) & "   ( " & Format(plgR(d, j), "ddd dd/mm/yy") & " )" & vbLf
                      VF = True
                    End If
                  End If
                Next
              End If
            ElseIf plgR(i, 1) = refDate Or IsEmpty(plgR(i, 1)) Then
              Exit For
            End If
          Next
        End If
      Next
      If VF Then msg = msg & vbLf
      VF = False
    End If
  Next
  If Len(msg) Then msg = vbLf & Left$(msg, Len(msg) - 1)
  Call Alerte(Message:=msg, Gauche:=90, Haut:=45, Activer:=True, Inclinaison:=5, CouleurFond:=RGB(20, 255, 240), CouleurTexte:=0, Graisse:=False, Transparence:=0.12)
Exit Sub
'Gestionnaire d'erreurs de lecture des paramètres :
E1:
  MsgBox "Aucun contrôle à faire." 'Parce que la liste du
'personnel est vide et/ou il n'y a pas de données à traiter.
  End
End Sub