Sub 凑数()
k = Cells(Rows.Count, 1).End(xlUp).Row
Range("b3:b" & k).Clear
m = Range("a3:a" & k).Rows.Count
n = [a1] / m
For x = 3 To k
Range("b" & x) = Rnd() * Range("a1") / 15
Next
l = Application.WorksheetFunction.Sum(Range("b3:b" & k))
y = ([a1] - l) / m
For x = 3 To k
Range("b" & x) = Range("b" & x) + y
Next