Option Compare Text 'la casse est ignorée
Private Sub CBnTirage_Click()
Dim cible, Lcible, Ccible, ntir, TNoms(), LOt As ListObject, TRésu(), M As Long, L As Long, J As Long, C As Long, flag As Boolean
cible = [D30]: Lcible = Range([D31]).Row - 3: Ccible = Range([D31]).Column - 1
For ntir = 1 To 100
On Error Resume Next
TNoms = [TbProfs[Professeur]].Value
If Err Then MsgBox "Table des professeurs indisponible", vbCritical, "Tirage": Exit Sub
On Error GoTo 0
If UBound(TNoms, 1) Mod 3 > 0 Then MsgBox "Le nombre de professeurs doit être un multiple de 3", vbCritical, "Tirage": End
Set LOt = Me.ListObjects(1): M = (LOt.ListColumns.Count - 1) \ 3
If TiragePSimOK(NbJrs:=UBound(TNoms, 1), MMax:=M, RClubs:=[TbProfs[Etablissement]]) Then
ReDim TRésu(1 To UBound(Tirage, 2), 1 To UBound(Tirage, 1) * 3)
For L = 1 To UBound(Tirage, 2)
C = 0
For M = 1 To UBound(Tirage, 1): For J = 1 To 3
C = C + 1
TRésu(L, C) = TNoms(Tirage(M, L, J), 1)
If TRésu(L, C) = cible Then If L = Lcible And C = Ccible Then flag = True
Next J, M, L
1 With Me.ListObjects(1).DataBodyRange
L = .Rows.Count - UBound(TRésu, 1)
Select Case Sgn(L)
Case 1: .Rows(2).Resize(L).Delete xlShiftUp
Case -1: .Rows(2).Resize(-L).Insert xlShiftDown
End Select
.Columns(2).Resize(, UBound(TRésu, 2)).Value = TRésu: End With
End If
If flag Then Range([D31]) = cible: Exit For
Next ntir
MsgBox IIf(flag, "Cible trouvée", "Cible NON trouvée")
End Sub
