Sub Tirages()
Dim tablo As Range, nNom%, delai%, dferie As Object, c As Range, dinterdit As Object
Dim d As Object, col%, nSam%, r1%, r2%, txt$, rejet As Boolean, ecart%
Set tablo = [Tableau1] 'tableau structuré
nNom = tablo.Rows.Count
delai = 42 'au moins 42 jours avant de réutiliser un nom
'---jours fériés à éliminer---
Set dferie = CreateObject("Scripting.Dictionary")
For Each c In [feries]
If Weekday(c) = 7 Then dferie(c.Value) = ""
Next c
'---binômes interdits---
Set dinterdit = CreateObject("Scripting.Dictionary")
For Each c In [Tableau5].Columns(1).Cells
dinterdit(c & vbLf & c(1, 2)) = ""
dinterdit(c(1, 2) & vbLf & c) = ""
Next c
Application.ScreenUpdating = False
Randomize
1 Set d = CreateObject("Scripting.Dictionary")
With Sheets("CALENDRIER").Range("A5:Y35")
'---RAZ---
For col = 3 To 25 Step 2
.Columns(col) = ""
Next col
'---tirages aléatoires---
For col = 2 To 24 Step 2
For Each c In .Columns(col).Cells
If IsDate(c) Then
If Weekday(c) = 7 Then
If Not dferie.exists(c.Value) Then
nSam = nSam + 1
Do
r1 = 1 + Int(Rnd * nNom)
r2 = 1 + Int(Rnd * nNom)
txt = tablo(r1, 1) & vbLf & tablo(r2, 1)
rejet = r1 = r2 Or dinterdit.exists(txt) Or c < d(r1) Or c < d(r2) 'cette variable fait gagner du temps
If Not rejet Then
c(1, 2) = txt
ecart = Application.Max(tablo) - Application.Min(tablo)
End If
Loop While rejet Or ecart > 1
d(r1) = c + delai 'mémorise la dernière date limite du 1er nom
d(r2) = c + delai 'mémorise la dernière date limite du 2ème nom
End If
End If
End If
Next c, col
End With
'---écart nul---
If nSam Mod nNom = 0 And ecart Then GoTo 1 'si nécessaire...
End Sub