Sub Tir()
Dim Ta(), Tb&(), Tc&(), Td&(), Te$(), Tf&(), i&, j&, k&
'grille (rang des combins)
ReDim Tb(1 To 10, 1 To 10)
Ta = Array(1, 150, 167, 112, 123, 127, 44, 56, 79, 177): i = 1
For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
Ta = Array(38, 37, 157, 88, 138, 172, 84, 122, 108, 10): i = i + 1
For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
Ta = Array(71, 2, 36, 136, 65, 169, 173, 158, 121, 101): i = i + 1
For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
Ta = Array(100, 174, 3, 35, 135, 140, 181, 147, 91, 39): i = i + 1
For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
Ta = Array(125, 155, 42, 4, 34, 188, 90, 107, 70, 171): i = i + 1
For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
Ta = Array(146, 73, 106, 67, 5, 33, 128, 144, 49, 189): i = i + 1
For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
Ta = Array(163, 59, 96, 183, 77, 6, 32, 54, 152, 114): i = i + 1
For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
Ta = Array(176, 142, 154, 46, 110, 55, 7, 31, 134, 92): i = i + 1
For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
Ta = Array(185, 86, 75, 170, 50, 115, 162, 8, 30, 69): i = i + 1
For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
Ta = Array(190, 178, 131, 117, 148, 40, 57, 82, 9, 29): i = i + 1
For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
Erase Ta
Randomize
'mélange colonnes & lignes
For k = 1 To 2
ReDim Tc(1 To 10)
For i = 1 To 10
Do
j = Int(10 * Rnd) + 1
Loop Until Tc(j) = 0
Tc(j) = i
Next i
If k = 1 Then
ReDim Td(1 To 10, 1 To 10)
For i = 1 To 10: For j = 1 To 10
Td(i, j) = Tb(i, Tc(j))
Next j, i
Else
For i = 1 To 10: For j = 1 To 10
Tb(i, j) = Td(Tc(i), j)
Next j, i
Erase Tc: Erase Td
End If
Next k
'grille (numéros)
ReDim Tc(1 To 10, 1 To 10, 1 To 2)
For i = 1 To 10: For j = 1 To 10
Td = CombinNthTab(20, 2, Tb(i, j))
For k = 1 To 2
Tc(i, j, k) = Td(k)
Next k, j, i
Erase Tb: Erase Td
'mélange numéros
ReDim Tb(1 To 20)
For i = 1 To 20
Do
j = Int(20 * Rnd) + 1
Loop Until Tb(j) = 0
Tb(j) = i
Next i
'écritures
ReDim Te(1 To 20)
For i = 1 To 20: Te(i) = Cells(i + 1, 1): Next i
For i = 1 To 10: For j = 1 To 10: For k = 1 To 2
Cells(i + 3, 2 * (j - 1) + 3 + k) = Te(Tb(Tc(i, j, k)))
Next k, j, i
Erase Tb: Erase Tc: Erase Te
Cells.EntireColumn.AutoFit
End Sub
Function CombinNthTab(ByVal a&, ByVal b&, ByVal n&) As Long()
Dim Tb&(), i&, x&, d&
ReDim Tb(b)
Do
d = d + 1: x = 0
For i = a - 1 - Tb(d - 1) To b - d Step -1
x = x + CombinNb(i, b - d)
If Not n > x Then Exit For
Next i
Tb(d) = a - i
n = n - (x - CombinNb(i, b - d))
Loop Until d = b
CombinNthTab = Tb
End Function
Function CombinNb(ByVal a&, ByVal b&) As Double
Dim c&
c = a - b
If c = 0 Then
CombinNb = 1
Else
If b < c Then c = b
CombinNb = Factorielle(a, c) / Factorielle(c)
End If
End Function
Function Factorielle(ByVal Lg&, Optional NbIter) As Double
Dim i&, n&
If Not IsMissing(NbIter) Then n = CLng(NbIter) Else n = Lg
Factorielle = 1
If Lg <> 0 Then
For i = 0 To n - 1: Factorielle = Factorielle * (Lg - i): Next i
End If
End Function