Sub FillRandomize()
Dim sh As Worksheet
Dim iRw As Integer
Dim dblHour As Double, dblNewValue As Double, dblRest As Double, dblSum As Double, dblTMP As Double
Dim iCnt As Integer
Dim iMxMonth As Integer
Set sh = ActiveSheet
For iRw = 2 To sh.UsedRange.Rows.Count
sh.Range(sh.Cells(iRw, 2), sh.Cells(iRw, sh.UsedRange.Columns.Count)).Delete
dblHour = Val(sh.Cells(iRw, 1).Formula)
iMxMonth = (Rnd() * 15) + 15
dblSum = 0
For iCnt = 1 To iMxMonth
dblRest = dblHour - dblSum
dblNewValue = Rnd() * dblRest
If Rnd() > 0.5 Then
sh.Cells(iRw, iCnt + 1) = dblNewValue
dblSum = dblSum + dblNewValue
End If
Next
If dblSum < dblHour Then
sh.Cells(iRw, iCnt + 1) = dblHour - dblSum
End If
Next
End Sub