Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
Sub Combinaisons()
Dim N, lig&, i, j, k, a(1 To 4)
If Val([B1]) < 3 Then [B1] = 3
N = Val([B1])
lig = 1
Application.ScreenUpdating = False
Range("C2:F" & Rows.Count).ClearContents 'RAZ
Randomize
For i = 1 To N - 2
For j = i + 1 To N - 1
For k = j + 1 To N
a(1) = Rnd 'nombre aléatoire
a(2) = i: a(4) = j: a(3) = k
lig = lig + 1
Cells(lig, "C").Resize(, 4) = a
Next k, j, i
N = Application.Combin(N, 3) 'nombre de combinaisons
Cells(2, "C").Resize(N, 4).Sort Columns("C"), Header:=xlNo 'tri aléatoire des combinaisons
Cells(2, "C") = 1
Cells(2, "C").Resize(N).DataSeries 'numérotation
End Sub
Sub Rotations()
Dim N, lig&, i&, a(1 To 4)
Combinaisons
If Val([H1]) < 1 Then [H1] = 1
N = Val([H1])
lig = 1
Range("I2:L" & Rows.Count).ClearContents 'RAZ
Do
For i = 2 To Application.Max(Columns("C")) + 1
If lig > N Then Exit Sub
a(1) = lig: a(2) = Cells(i, 4): a(3) = Cells(i, 5): a(4) = Cells(i, 6)
lig = lig + 1
Cells(lig, "I").Resize(, 4) = a
Next i
Loop While lig < N
End Sub
Sub Combinaisons()
Dim N, lig&, i, j, k, a(1 To 4)
If Val([B1]) < 3 Then [B1] = 3
N = Val([B1])
lig = 1
Application.ScreenUpdating = False
Range("C2:F" & Rows.Count).ClearContents 'RAZ
For i = 1 To N - 2
For j = i + 1 To N - 1
For k = j + 1 To N
a(1) = lig: a(2) = i: a(3) = j: a(4) = k
lig = lig + 1
Cells(lig, "C").Resize(, 4) = a
Next k, j, i
End Sub
Sub Rotations()
Dim N, lig&, i&, a(1 To 4)
Combinaisons
If Val([H1]) < 1 Then [H1] = 1
N = Val([H1])
lig = 1
Range("I2:L" & Rows.Count).ClearContents 'RAZ
Randomize
Do
For i = 2 To Application.Max(Columns("C")) + 1
If lig > N Then Exit Do
a(1) = Rnd 'nombre aléatoire
a(2) = Cells(i, 4): a(3) = Cells(i, 5): a(4) = Cells(i, 6)
lig = lig + 1
Cells(lig, "I").Resize(, 4) = a
Next i
Loop While lig < N
Cells(2, "I").Resize(N, 4).Sort Columns("I"), Header:=xlNo 'tri aléatoire
Cells(2, "I") = 1
Cells(2, "I").Resize(N).DataSeries 'numérotation
End Sub
Sub Tableau_final_2022()
'Ex : l'agent 1 est en vacances du 12 au 17 Février , l'agent 12 est absent tout le mois d'aout
'et l'agent 13 n'est pas encore formé , le 15 lui n'est pas là le 23 Mars ...
Dim R As Range, lig&, i&, dat As Date, x$, exclu1 As Boolean, exclu2 As Boolean, exclu3 As Boolean, exclu4 As Boolean
Rotations
Set R = [N1].CurrentRegion
lig = 1
For i = 2 To R.Rows.Count
dat = R(i, 1)
Do
lig = lig + 1
x = Chr(1) & Cells(lig, "J") & Chr(1) & Cells(lig, "K") & Chr(1) & Cells(lig, "L") & Chr(1) 'numéros encadrés
exclu1 = InStr(x, Chr(1) & 1 & Chr(1)) > 0 And dat >= CDate("12/02/22") And dat <= CDate("17/02/22")
exclu2 = InStr(x, Chr(1) & 12 & Chr(1)) > 0 And dat >= CDate("01/08/22") And dat <= CDate("31/08/22")
exclu3 = InStr(x, Chr(1) & 13 & Chr(1)) > 0
exclu4 = InStr(x, Chr(1) & 15 & Chr(1)) > 0 And dat = CDate("23/03/22")
Loop While exclu1 Or exclu2 Or exclu3 Or exclu4
R(i, 2).Resize(, 3) = Cells(lig, "J").Resize(, 3).Value
Next i
End Sub
Si je comprends bien cela fait 4 critères d'exclusions supplémentaires, voyez ce fichier (4) :J'aimerais aussi pouvoir interdire provisoirement certaines associations par exemple , je ne veux pas que le 2 soit associé avec le 16 ou le 1 avec le 13 , le 8 et le 5 .
Sub Tableau_final_2022()
'Ex : l'agent 1 est en vacances du 12 au 17 Février , l'agent 12 est absent tout le mois d'aout
'et l'agent 13 n'est pas encore formé , le 15 lui n'est pas là le 23 Mars ...
'J'aimerais aussi pouvoir interdire provisoirement certaines associations par exemple , je ne veux pas que le 2 soit associé avec le 16 ou le 1 avec le 13 , le 8 et le 5
Dim R As Range, lig&, i&, dat As Date, x$, exclu1, exclu2, exclu3, exclu4, exclu5, exclu6, exclu7, exclu8
Rotations
Set R = [N1].CurrentRegion
lig = 1
For i = 2 To R.Rows.Count
dat = R(i, 1)
Do
lig = lig + 1
x = Chr(1) & Cells(lig, "J") & Chr(1) & Cells(lig, "K") & Chr(1) & Cells(lig, "L") & Chr(1) 'numéros encadrés
exclu1 = InStr(x, Chr(1) & 1 & Chr(1)) > 0 And dat >= CDate("12/02/22") And dat <= CDate("17/02/22")
exclu2 = InStr(x, Chr(1) & 12 & Chr(1)) > 0 And dat >= CDate("01/08/22") And dat <= CDate("31/08/22")
exclu3 = InStr(x, Chr(1) & 13 & Chr(1)) > 0
exclu4 = InStr(x, Chr(1) & 15 & Chr(1)) > 0 And dat = CDate("23/03/22")
exclu5 = InStr(x, Chr(1) & 2 & Chr(1)) > 0 And InStr(x, Chr(1) & 16 & Chr(1)) > 0
exclu6 = InStr(x, Chr(1) & 1 & Chr(1)) > 0 And InStr(x, Chr(1) & 13 & Chr(1)) > 0
exclu7 = InStr(x, Chr(1) & 1 & Chr(1)) > 0 And InStr(x, Chr(1) & 8 & Chr(1)) > 0
exclu8 = InStr(x, Chr(1) & 1 & Chr(1)) > 0 And InStr(x, Chr(1) & 5 & Chr(1)) > 0
Loop While exclu1 Or exclu2 Or exclu3 Or exclu4 Or exclu5 Or exclu6 Or exclu7 Or exclu8
R(i, 2).Resize(, 3) = Cells(lig, "J").Resize(, 3).Value
Next i
End Sub
Sub Tableau_2022()
'Ex : l'agent 1 est en vacances du 12 au 17 Février , l'agent 12 est absent tout le mois d'aout
'et l'agent 13 n'est pas encore formé , le 15 lui n'est pas là le 23 Mars ...
'J'aimerais aussi pouvoir interdire provisoirement certaines associations par exemple , je ne veux pas que le 2 soit associé avec le 16 ou le 1 avec le 13 , le 8 et le 5
Dim N, agent%, R As Range, i&, dat As Date, j%, x$, exclu1, exclu2, exclu3, exclu4, exclu5, exclu6, exclu7, exclu8
N = 20 'nombre d'agents, à adapter
agent = 0 'de 0 à N - 1, modifiable chaque année
Set R = [A1].CurrentRegion
Application.ScreenUpdating = False
R.Columns(2).Resize(, 3).ClearContents 'RAZ
For i = 2 To R.Rows.Count
dat = R(i, 1)
For j = 2 To 4
Do
agent = agent + 1
If agent > N Then agent = 1 'rotation
R(i, j) = agent
x = Chr(1) & R(i, 2) & Chr(1) & R(i, 3) & Chr(1) & R(i, 4) & Chr(1) 'numéros encadrés
exclu1 = InStr(x, Chr(1) & 1 & Chr(1)) > 0 And dat >= CDate("12/02/22") And dat <= CDate("17/02/22")
exclu2 = InStr(x, Chr(1) & 12 & Chr(1)) > 0 And dat >= CDate("01/08/22") And dat <= CDate("31/08/22")
exclu3 = InStr(x, Chr(1) & 13 & Chr(1)) > 0
exclu4 = InStr(x, Chr(1) & 15 & Chr(1)) > 0 And dat = CDate("23/03/22")
exclu5 = InStr(x, Chr(1) & 2 & Chr(1)) > 0 And InStr(x, Chr(1) & 16 & Chr(1)) > 0
exclu6 = InStr(x, Chr(1) & 1 & Chr(1)) > 0 And InStr(x, Chr(1) & 13 & Chr(1)) > 0
exclu7 = InStr(x, Chr(1) & 1 & Chr(1)) > 0 And InStr(x, Chr(1) & 8 & Chr(1)) > 0
exclu8 = InStr(x, Chr(1) & 1 & Chr(1)) > 0 And InStr(x, Chr(1) & 5 & Chr(1)) > 0
Loop While exclu1 Or exclu2 Or exclu3 Or exclu4 Or exclu5 Or exclu6 Or exclu7 Or exclu8
Next j, i
End Sub
Parce que vous avez dir "l'agent 13 n'est pas encore formé".pourquoi n'y a t'il pas de combinaisons avec le 13 ?
We use cookies and similar technologies for the following purposes:
Est ce que vous acceptez les cookies et ces technologies?
We use cookies and similar technologies for the following purposes:
Est ce que vous acceptez les cookies et ces technologies?