1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
|
Dim ti(1000) As Integer
Dim NombresAJouer As Variant, d As Variant
Dim liste As Object
Set liste = CreateObject("scripting.dictionary")
NombresAJouer = Split(Cells(2, 1), "-")
d = NombresAJouer
ne = UBound(NombresAJouer, 1)
NbCombinaisonsAGenerer = Cells(2, 3)
LongeurCombinaisonsAFG = Cells(2, 2)
calcnc = Application.WorksheetFunction.Fact(ne + 1) / Application.WorksheetFunction.Fact(LongeurCombinaisonsAFG)
If calcnc < NbCombinaisonsAGenerer Then MsgBox "il n'y a que " & calcnc & " possibilités, je limite le nombre de tirages à " & calcnc: NbCombinaisonsAGenerer = calcnc
liste.RemoveAll
For i = 1 To NbCombinaisonsAGenerer
ok = False
While Not (ok)
Erase ti
NombresAJouer = d
nec = ne
For j = 1 To LongeurCombinaisonsAFG
t = Application.WorksheetFunction.RandBetween(0, nec)
ti(j) = NombresAJouer(t)
NombresAJouer(t) = NombresAJouer(nec)
nec = nec - 1
Next j
For k = 1 To LongeurCombinaisonsAFG - 1
For k1 = k + 1 To LongeurCombinaisonsAFG
If ti(k) > ti(k1) Then a = ti(k): ti(k) = ti(k1): ti(k1) = a
Next k1
Next k
sep = ""
tir = ""
For k = 1 To LongeurCombinaisonsAFG
tir = tir & sep & ti(k)
If sep = "" Then sep = "-"
Next k
If liste.Exists(tir) Then
ok = False
Else
ok = True
liste.Add tir, i
Cells(i + 2, 3) = tir
End If
Wend
Next i |
Partager