Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, i As Variant, r As Range, mini&, n%, x$, y$, z$, mes$
If Intersect(Target, [S5]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
On Error Resume Next 'si aucune SpecialCell
[S5].Select
[S5] = Val(CStr([S5])) 'au cas où...
Set P = [A6:R600] 'plage adaptable
P.Columns(7).Resize(, 12) = "" 'RAZ
For i = 1 To P.Rows.Count
If P(i, 2) <> "" Then
Range("G2:R2") = "=SEARCH(""" & P(i, 1) & """,G1)" 'analyse des disponibilités
'---M. Armant (on commence par lui car c'est le moins disponible)---
If P(i, 5) <> "" Then
Set r = Nothing
Set r = Range("G2,N2").SpecialCells(xlCellTypeFormulas, 1)
If Not r Is Nothing Then
mini = Application.Min(Intersect(r.EntireColumn, Rows(3))) 'minimum en ligne 3
For Each r In r
If r(2) = mini Then r(i + 4) = P(i, 5): Exit For
Next r
End If
End If
'---M. Yuste---
If P(i, 3) <> "" Then
If P(i, 14) = P(i, 3) Then Range("M2") = "" 'neutralise la colonne M si doublon
Set r = Nothing
Set r = Range("H2:M2").SpecialCells(xlCellTypeFormulas, 1)
If Not r Is Nothing Then
mini = Application.Min(Intersect(r.EntireColumn, Rows(3))) 'minimum en ligne 3
For Each r In r
If r(2) = mini Then r(i + 4) = P(i, 3): Exit For
Next r
End If
End If
'---Mme Querat---
If P(i, 4) <> "" Then
If P(i, 13) = P(i, 4) Or P(i, 14) = P(i, 4) Then Range("O2") = "" 'neutralise la colonne O si doublon
Set r = Nothing
Set r = Range("O2:R2").SpecialCells(xlCellTypeFormulas, 1)
If Not r Is Nothing Then
mini = Application.Min(Intersect(r.EntireColumn, Rows(3))) 'minimum en ligne 3
For Each r In r
If r(2) = mini Then r(i + 4) = P(i, 4): Exit For
Next r
End If
End If
End If
Next i
'[G2:R2] = "" 'facultatif, mettre en commentaire pour voir les formules
'---filtrage sur la colonne B et liste des absents---
Union(P.Rows(0), P).AutoFilter Field:=2, Criteria1:="<>"
i = Application.Match("X", P(1, 2).EntireColumn, 0)
If IsNumeric(i) Then ActiveWindow.ScrollRow = i
n = Evaluate("MAX(LEN(" & P.Columns(3).Resize(, 3).Address & "))") + 1 'nombre maximum de caractères
For i = 1 To P.Rows.Count
If P(i, 2) <> "" Then
x = P(i, 3): y = P(i, 4): z = P(i, 5)
If x <> "" Then If Application.CountIf(P(i, 8).Resize(, 6), x) = 0 Then mes = mes & vbLf & x & String(n - Len(x), " ") & "(Mr Yuste)"
If y <> "" Then If Application.CountIf(P(i, 15).Resize(, 4), y) = 0 Then mes = mes & vbLf & y & String(n - Len(y), " ") & "(Mme Querat)"
If z <> "" Then If P(i, 7) <> z And P(i, 14) <> z Then mes = mes & vbLf & z & String(n - Len(z), " ") & "(Mr Armant)"
End If
Next i
If mes <> "" Then
Nbre_élèves = UBound(Split(mes, vbLf)) 'mémorisée dans Module1 pour l'USF
With UserForm2
.TextBox1 = "ATTENTION !!! Les élèves suivants n'ont pas d'intervenant à cause de leur EDT :" & mes
.Show 0 'non modal
.TextBox1.SetFocus
.TextBox1.SelStart = 0
.CMD_OK.SetFocus
End With
End If
Application.EnableEvents = True 'réactive les évènements
Application.ScreenUpdating = True
End Sub