Private Sub Worksheet_Change(ByVal Target As Range)
Dim NbPlaces As Range, P As Range, mem, maxi As Variant, a() As Boolean, t, i&, j&
Set NbPlaces = [E1] 'cellule à adapter
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
If CLng(NbPlaces) < 1 Then NbPlaces = 0
NbPlaces = CLng(NbPlaces)
Set P = Me.UsedRange.Resize(, 4)
'---tri du tableau---
If Not Intersect(Target, P.Columns(1)) Is Nothing Then
If Target.Count = 1 Then mem = Target
P.Sort P(1), xlAscending, Header:=xlYes
P(Application.Match(mem, P.Columns(1), 0), 1).Select
End If
'---suppressions des lignes des noms effacés---
Intersect(P, P.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow).Delete xlUp
'---contrôle du nombre de places---
If Not Intersect(Target, NbPlaces) Is Nothing Then If NbPlaces < Application.Max(P.Columns(4)) _
Then If MsgBox("Vous venez de diminuer le nombre de places." & vbLf & _
"Voulez-vous effacer celles qui dépassent ce nombre ?", 52) = 6 Then maxi = NbPlaces
'---mémorisation des places attribuées---
ReDim a(1 To NbPlaces)
t = P.Columns(2).Resize(, 3) 'matrice, plus rapide
For i = 2 To UBound(t)
If IsNumeric(CStr(t(i, 3))) And t(i, 1) <> "" Then a(t(i, 3)) = True
Next i
'---attribution/effacement des places---
For i = 2 To UBound(t)
If maxi <> "" Then If t(i, 3) > maxi Then t(i, 1) = ""
If t(i, 1) = "" Then
If t(i, 3) <> "" Then t(i, 2) = "": t(i, 3) = ""
Else
If Not IsNumeric(CStr(t(i, 3))) Then
For j = 1 To UBound(a)
If a(j) Then Else t(i, 3) = j: a(j) = True: Exit For
Next j
t(i, 2) = Now 'heure
If Not IsNumeric(CStr(t(i, 3))) Then t(i, 3) = "n/a" 'pas nécessaire s'il y a une validation des données en colonne B
End If
End If
Next i
[B1].Resize(UBound(t), 3) = t 'restitution
Application.EnableEvents = True 'réactive les évènements
End Sub