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 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
| 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 |
Partager