Option Explicit
Sub Repartition()
Dim t1#, t2#, n&, i&, p#, j&, c&, g#, v&, x(), y()
n = Cells(Rows.Count, 1).End(xlUp).Row - 1
ReDim x(1 To n, 1 To 3): ReDim y(1 To 6, 1 To 10)
For i = 2 To n + 1
p = p + Cells(i, 2): x(i - 1, 1) = Cells(i, 1): x(i - 1, 2) = Cells(i, 2)
Next i
Line1:
t1 = Now: Randomize
For i = 2 To n + 1
x(i - 1, 3) = 0
Next i
For j = 1 To 6
c = 0: g = 0
Do
v = Int(Rnd * n + 1)
If x(v, 3) = 0 Then
c = c + 1: x(v, 3) = j: g = g + x(v, 2)
End If
t2 = Now - t1
If t2 > 2 * 10 ^ -5 Then GoTo Line1
Loop Until c = 9
Do Until g < p / n * 9 + 0.5 And g > p / n * 9 - 0.5
v = Int(Rnd * 9 + 1): c = 0
For i = 1 To n
If x(i, 3) = j Then
c = c + 1
If c = v Then
x(i, 3) = 0: g = g - x(i, 2)
Do
v = Int(Rnd * n + 1)
Loop Until x(v, 3) = 0
x(v, 3) = j: g = g + x(v, 2)
End If
End If
Next i
t2 = Now - t1
If t2 > 2 * 10 ^ -5 Then GoTo Line1
Loop
c = 0
For i = 1 To n
If x(i, 3) = j Then
c = c + 1: y(j, c) = x(i, 1): If c = 9 Then Exit For
End If
Next i
y(j, 10) = g
Next j
For i = 1 To n
Cells(i + 1, 3) = x(i, 3)
Next i
End Sub