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

Sub P7J()
Dim Pers(), HCl(), plgR(), refDate$
Dim i&, j&, k&, p&, d&, VF1 As Boolean, VF2 As Boolean
Dim c&, ep$
Dim d1 As Date, d2 As Date
    With Worksheets("Paramètres")
'Lecture des paramètres.
        On Error GoTo E1
'Liste du personnel. Elle peut comporter des lignes vides, mais pas de doublon.
        Pers = .[A1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row).Value
        On Error GoTo E2
'Liste des mentions ne donnant pas lieu à décompte. Elle peut être vide.
        HCl = .[B1].Resize(.Cells(.Rows.Count, 2).End(xlUp).Row).Value
        On Error GoTo 0
'Intitulé de la ligne portant les dates. Valeur unique.
        refDate = .[C2].Value
    End With
    With Worksheets("Cycle Planning")
'Lecture des données à traiter.
        On Error GoTo E1
'La plage de données à traiter commençant en A1 doit avoir un nombre constant de colonnes.
'Le nombre de lignes est indifférent. Chaque bloc de données peut même avoir un nombre
'différent de lignes. L'ordre des noms des employés peut être différent dans chaque bloc.
        plgR = .[A1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(2, .Columns.Count).End(xlToLeft).Column).Value
        On Error GoTo 0
    End With
'Traitement des données.
'On traite chaque employé tour à tour.
    For p = 2 To UBound(Pers, 1)
        If Not IsEmpty(Pers(p, 1)) Then
            ep = Pers(p, 1)
'Pour un employé donné, on parcourt la plage de données ligne par ligne...
            For d = 1 To UBound(plgR, 1)
'...jusqu'à y trouver une ligne de dates.
                If plgR(d, 1) = refDate Then
'Une ligne de dates étant trouvée on parcourt les lignes suivantes...
                    For i = d + 1 To UBound(plgR, 1)
'...jusqu'à y trouver le nom de l'employé recherché.
                        If plgR(i, 1) = ep Then
'Si le nom de l'employé est trouvé, on parcourt la ligne de données.
                            For j = 2 To UBound(plgR, 2)
'Pour chacune des cellules de cette ligne, on regarde son contenu en utilisant le booléen VF1.
'Si la cellule est vide ou contient une mention ne donnant pas lieu à décompte, on pose VF1=Vrai.
                                VF1 = IsEmpty(plgR(i, j))
                                For k = 2 To UBound(HCl, 1)
                                    VF1 = VF1 Or plgR(i, j) = HCl(k, 1)
                                Next
                                If VF1 Then
'Dans le cas où VF1 est Vrai et où le compteur c d'occurrences successives de "VF1=Faux" excède 6,
'on affiche un message d'alerte.
                                    If c > 6 Then MsgBox ep & " :" & vbLf & "du " & d1 & " au " & d2
'Réinitialisation du booléen VF2 à Faux et du compteur c à zéro.
                                    VF2 = False
                                    c = 0
                                Else
'Dans le cas où VF1 est Faux, on note la date d2 correspondante, et on incrémente le compteur c
'd'occurrences successives de "VF1=Faux".
                                    d2 = plgR(d, j)
                                    c = c + 1
                                    If Not VF2 Then
'Si le booléen VF2 a la valeur Faux, on lui attribue la valeur Vrai et on note la date
'd1 correspondante. (d1 est donc la date de début d'une séquence de cellules telle que
'VF1 garde la valeur Faux.)
                                        VF2 = True
                                        d1 = plgR(d, j)
                                    End If
                                End If
'Passage à la cellule à droite.
                            Next
                        ElseIf plgR(i, 1) = refDate Or IsEmpty(plgR(i, 1)) Then
                            Exit For '...pour passer au bloc de données suivant.
                        End If
                    Next
                End If
'Passage au bloc de données suivant.
            Next
'Tous les blocs de données ayant été explorés, on affiche un dernier message d'alerte si besoin est...
            If c > 6 Then MsgBox ep & " :" & vbLf & "du " & d1 & " au " & d2
'...puis on réinitialise le booléen VF2 à la valeur Faux et le compteur c à zéro...
            VF2 = False
            c = 0
        End If
'...et on passe à l'employé suivant.
    Next
Exit Sub 'Ouf !
'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
E2:
    ReDim HCl(1 To 1, 1 To 1) '... dans le cas où la iste des mentions ne donnant pas lieu
'à décompte est vide.
    Resume Next
End Sub

=SOMMEPROD(ESTTEXTE(B1:P1)*(GAUCHE(B1:P1;4)<>"Astr")*ESTTEXTE(C1:Q1)*(GAUCHE(C1:Q1;4)<>"Astr")*ESTTEXTE(D1:R1)*(GAUCHE(D1:R1;4)<>"Astr")*ESTTEXTE(E1:S1)*(GAUCHE(E1:S1;4)<>"Astr")*ESTTEXTE(F1:T1)*(GAUCHE(F1:T1;4)<>"Astr")*ESTTEXTE(G1:U1)*(GAUCHE(G1:U1;4)<>"Astr")*ESTTEXTE(H1:V1)*(GAUCHE(H1:V1;4)<>"Astr"))+(SOMMEPROD(ESTTEXTE(Q1:V1)*(GAUCHE(Q1:V1;4)<>"Astr"))=6)*ESTTEXTE(B20)*(GAUCHE(B20;4)<>"Astr")+(SOMMEPROD(ESTTEXTE(R1:V1)*(GAUCHE(R1:V1;4)<>"Astr"))=5)*(SOMMEPROD(ESTTEXTE(B20:C20)*(GAUCHE(B20:C20;4)<>"Astr"))=2)+(SOMMEPROD(ESTTEXTE(S1:V1)*(GAUCHE(S1:V1;4)<>"Astr"))=4)*(SOMMEPROD(ESTTEXTE(B20:D20)*(GAUCHE(B20:D20;4)<>"Astr"))=3)+(SOMMEPROD(ESTTEXTE(T1:V1)*(GAUCHE(T1:V1;4)<>"Astr"))=3)*(SOMMEPROD(ESTTEXTE(B20:E20)*(GAUCHE(B20:E20;4)<>"Astr"))=4)+(SOMMEPROD(ESTTEXTE(U1:V1)*(GAUCHE(U1:V1;4)<>"Astr"))=2)*(SOMMEPROD(ESTTEXTE(B20:F20)*(GAUCHE(B20:F20;4)<>"Astr"))=5)+ESTTEXTE(V1)*(GAUCHE(V1;4)<>"Astr")*(SOMMEPROD(ESTTEXTE(B20:G20)*(GAUCHE(B20:G20;4)<>"Astr"))=6)

plgR = .[A1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(2, .Columns.Count).End(xlToLeft).Column).Value

plgR = .[A1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, .[V2].Column).Value

    With Worksheets("Cycle Planning")
        plgR = .[A1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(2, .Columns.Count).End(xlToLeft).Column).Value
    End With

    plgR = Worksheets("Cycle Planning").Range("DATA").Value

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
'Affichage des alertes dans une zone de texte.
        With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Gauche, Haut, 20, 20)
            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
        End With
    End If
End Function

    Call Alerte(Message:=msg, Gauche:=90, Haut:=45, Activer:=True, Inclinaison:=5, CouleurFond:=RGB(255, 255, 64), CouleurTexte:=0, Graisse:=False, Transparence:=0.12)
'peut s'écrire aussi:
    Call Alerte(msg, 90, 45, True, 5, RGB(255, 255, 64), 0, False, 0.12)
'ou :
    Call Alerte(msg, 90, 45, , 5, RGB(255, 255, 64), , , 0.12)
'ou :
    Alerte msg, 90, 45, , 5, RGB(255, 255, 64), , , 0.12

'En écrivant seulement...
    Alerte msg, 90, 45
'...on aura une zone de texte à fond blanc, activée, sans rotation ni transparence.

'Si on veut récupérer le nom de la zone de texte, on écrira :
Dim Nom_de_la_zone$ 'dans la déclaration des variables et :
    Nom_de_la_zone = Alerte(Message:=msg, Gauche:=90, Haut:=45, Activer:=True, Inclinaison:=5, CouleurFond:=RGB(255, 255, 64), CouleurTexte:=0, Graisse:=False, Transparence:=0.12)