Sub test2()
'La référence à Microsoft Scripting Runtime (scrrun.dll) doit être disponible.
Dim i&, j&, c&, u$, ITM(), DIC As New Dictionary
Dim plg As Range, dst As Range, n&, k&
'
Set plg = Range("O2:O13") '*** (données)
Set dst = Range("A1") '*** (début de tableau)
n = 20 '*** (nb. de sujets)
k = 100000 '*** (protection contre le bouclage éternel)
c = plg.Rows.Count
dst.Resize(n, c).Offset(1, 1).ClearContents
ITM = WorksheetFunction.Transpose(plg.Value)
Randomize
Do
For i = c To 1 Step -1
u = ITM(i)
ITM(i) = ITM(1 + Int(i * Rnd()))
ITM(1 + Int(i * Rnd(0))) = u
Next
u = Join(ITM, "/")
If DIC.Exists(u) Then
k = k - 1
Else
j = j + 1
DIC.Add u, Empty
dst.Resize(1, c).Offset(j, 1).Value = ITM
End If
Loop Until k = 0 Or j = n
End Sub
L'idée c'est qu'aucune condition ne soit suivi de la même suivante.
Par exemple le carré du type
1 2 3
2 3 1
3 1 2
N'est pas interessant car il n'y a pas de randomisation.
1 3 2
2 3 1
3 1 2
C'est ce type de carré que je souhaite !
couleur | jaune | bleu | rouge | vert | blanc |
nationalité | norvégien | danois | anglais | allemand | suédois |
boisson | eau | thé | lait | café | bière |
cigare | Dunhill | Blend | Pall Mall | Prince | Bluemaster |
animal | chats | cheval | oiseaux | poisson | chiens |