[COLOR="DarkSlateGray"][B]Private Sub Arrangements_Click()
Dim t As Single
t = Timer
tata_49
MsgBox Round(Timer - t, 2) & " s"
End Sub
Sub tata_49()
Dim i&, j&, k&, l&, m&, y&, z&
Dim sDat(1 To 65000, 1 To 19)
Range("C1:U65000").ClearContents
y = 1
For i = 1 To 45
For j = i + 1 To 46
For k = j + 1 To 47
For l = k + 1 To 48
For m = l + 1 To 49
If i Mod 2 + j Mod 2 + k Mod 2 + l Mod 2 + m Mod 2 > 1 Then
If (i < 10) + (j < 10) + (k < 10) + (l < 10) + (m < 10) > -3 Then
If (i > 39) + (j > 39) + (k > 39) + (l > 39) + (m > 39) > -3 Then
If (i > 9) * (i < 20) + (j > 9) * (j < 20) + (k > 9) * (k < 20) + (l > 9) * (l < 20) + (m > 9) * (m < 20) < 3 Then
If (i > 19) * (i < 30) + (j > 19) * (j < 30) + (k > 19) * (k < 30) + (l > 19) * (l < 30) + (m > 19) * (m < 30) < 3 Then
If (i > 29) * (i < 40) + (j > 29) * (j < 40) + (k > 29) * (k < 40) + (l > 29) * (l < 40) + (m > 29) * (m < 40) < 3 Then
z = z + 1
sDat(z, y) = i & "-" & j & "-" & k & "-" & l & "-" & m
If z = 65000 Then
y = y + 1
z = 0
End If
End If
End If
End If
End If
End If
End If
Next m
Next l
Next k
Next j
Next i
Range(Cells(1, 3), Cells(65000, 21)) = sDat
Erase sDat
End Sub[/B][/COLOR]