Sub Melanger()
Dim dico As New Scripting.Dictionary, Uniq As New Scripting.Dictionary
Dim xcell, res(), i&, j&, n&, li&, co&, OK As Boolean
'dico stocke les valeurs avec leur occurence
For Each xcell In Range("a3:e12")
dico(xcell.Value) = dico(xcell.Value) + 1
Next xcell
'le tableau res a une colonne de plus que le tableau résultat B
'cette colonne contient la valeur du doublon si on a placé
'un doublon quelque part sur la ligne
ReDim res(0 To 9, 0 To 5)
'on traite les doublons et plus
For i = 0 To dico.Count - 1
If dico.Items(i) > 1 Then
For j = 1 To dico.Items(i)
OK = False
Do While Not OK
n = Int(50 * Rnd)
li = Int(n / 5): co = n Mod 5
If res(li, co) = 0 And res(li, 5) <> dico.Keys(i) Then
'l'élément du tableau (li,co) est vide et le doublon ne
'figure pas déjà dans la ligne li
res(li, co) = dico.Keys(i)
'on stocke la valeur du doublon pour indiquer qu'on a
'mis une valeur de ce doublon dans la ligne li
'et ne pas y placer ce doublon une 2ième fois
res(li, 5) = res(li, co)
OK = True
End If
Loop
Next j
End If
Next i
'on traite les singletons
For i = 0 To dico.Count - 1
If dico.Items(i) = 1 Then Uniq.Add dico.Keys(i), ""
Next i
Set dico = Nothing
'dans les "trous" qui restent, on place les valeurs uniques
For i = 0 To 9
For j = 0 To 4
If res(i, j) = 0 Then
n = Int(Rnd * Uniq.Count)
res(i, j) = Uniq.Keys(n)
Uniq.Remove Uniq.Keys(n)
End If
Next j
Next i
ReDim Preserve res(0 To 9, 0 To 4)
Range("g3").Resize(10, 5).Value = res
End Sub
