verilen sayıyı gruplara bölme işlemi

[ahmetozbey]

sorum ekdedir
ilgilenirseniz memnun olurum.

 

[veyselemre]

ekteki örnek yaklaşık olarak eşit dağıtacak şekilde hazırlanmıştır.

 

[ahmetozbey]

arkadaşım sağol uğraşmışsın ama 1. grubun değeri diğer gruplardan büyük olmaması gerekir. bunu halletmemiz gerekir.ilgilenirseniz memnun olurum.

 

[veyselemre]

[vb:1:38993bc4cf]Sub deneme()
qc = WorksheetFunction.Ceiling([e5], 0.5)
sat = 9
'*********** 3 kademe
bol = 3: GoSub dagit
'*********** 5 kademe
bol = 5: GoSub dagit
'*********** 7 kademe
bol = 7: GoSub dagit
'*********** 12 kademe
bol = 12: GoSub dagit

Exit Sub
dagit:
sat = sat + 1
st = WorksheetFunction.RoundUp(qc / bol, 0.5)
par1 = qc - ((bol - 1) * st)

par:
If par1 < 0.5 Then
st = st - 0.5
par1 = qc - ((bol - 1) * st)
End If

If par1 < 0.5 Then GoTo par

If par1 < st Then
Cells(sat, 6) = par1
Cells(sat, 6 + (bol - 1) * 2) = st
Else
Cells(sat, 6) = st
Cells(sat, 6 + (bol - 1) * 2) = par1
End If
For x = 8 To 6 + ((bol - 2) * 2) Step 2
Cells(sat, x) = st
Next x

Return

End Sub[/vb:1:38993bc4cf]

 

[ahmetozbey]

teşekkür ederim ellerinize sağlık