(03/01/2020, 09:10)berduş yazdı: 1 - neden r1=4?
2 - diyelim ki farkı bulduk sonuç=8 dağılım orantısal olmadığı için bizde bir sana bir bana bir ona yaptık, yani en büyükten başlayıp en küçüğe 1er 1er dağıtıp tekrar en başa dönüp kalanı yine 1er 1er dağıttık bu doğru dağılım olur mu?
13 --> 2
5 -->  2
4 -->  2
3 -->  1
1 -->  1
gibi

r1=4 olmasının bir anlamı yok. örnekleme yaparken unutulmuş bir sayı.

evet aslında mantık bu şekilde olacak, büyük olan geri kalandan  büyük payı alacak.


8     8      6       5       1   =28            28-18=10
3     3      2       1       1   =10
---------------------------------------------------------------------

8      8      6       5       1   =28
3      2      2       2       1   =10       --------------------------------->>>>>>>>>>>>>    her ikiside olur.  ama 1 daima 1 olmak zorunda...

Peki kalan=0 ise
15 --> ?
0 --> ?
1 --> ?
1 --> ?
1 --> ?
Yada kalan=1 ise
16 --> ?
0 --> ?
1 --> ?
1 --> ?
1 --> ?
Yada 0dan küçükse

Acikcasi dagilimin nasil olmasi gerektigine dair daha ayrintili bilgi verirseniz daha iyi olur.

Değer P=0 ise 0, 

P=1 ise 1 olacak.

Ancak diğer dağılımlar çok önemli değil sadece.  P değerlerinin büyüklük değerine gore karşı değeri büyük olacak.



Örneğinzdeki gibi KALAN 1 ise bu değeri buyuk olan sayıya verecek. Diğerlerinin değeri 0 olacak

Örneğin 

Kalan 2 olsaydı

1 in  bir tanesini en buyuk sayıya diğerini herhangi bir sayıya veya  Kalan 2 yi en büyük sayıya vermesinin sakıncası yok.


Kısaca 0 olmayan her P değeri için değer vermesinin sakıncası yok.

Kalan 0 veya 18 den kucuk ise hiç R değeri vermeyecek tüm değerler 0 olacak.


Aslında sizin söylediğiniz çok mantıklı geldi bana dolu olan P değerlerine dağıtılacak sayı var ise küçükten başlayarak dağıtması. Ve bunu sayılar büyüdükçe arttırması çok mantıklı geliyor.h

aşağıdaki procedürü forma ekleyip ister butondan ister "Form geçerli olduğunda" olayından çağırabilirsiniz
dilerim işinize yarar

Private Sub Dagilim()



Dim Kalan, x, CtlDeger, Toplam As Integer

Dim MtnDizi, CtlAdi As String

Dim xDizi() As String

Kalan = 0

Toplam = 0

MtnDizi = ""



For x = 1 To 5

    Toplam = Toplam + Nz(Controls("P" & x), 0) 'P alanlarındaki değerleri Topla

    MtnDizi = MtnDizi & ";P" & x & Nz(Controls("P" & x), 0) 'diziye aktarabilmek için PAlanAdı+değeri

    Controls("R" & x) = 0 'Ralanlarının ilk değerini 0 yap

Next x



MtnDizi = Mid(MtnDizi, 2) 'diziye aktarılacak metindeki ilk ";" kaldır

Kalan = Toplam - 18

xDizi = Split(MtnDizi, ";") 'diziye aktar

'hy Dizi_Sırala_______________________________________Küçükten Büyüge

    First = LBound(xDizi)

    Last = UBound(xDizi)

    For i = First To Last - 1

        For j = i + 1 To Last

            If CInt(Mid(xDizi(i), 3)) > CInt(Mid(xDizi(j), 3)) Then

                Temp = xDizi(j)

                xDizi(j) = xDizi(i)

                xDizi(i) = Temp

            End If

        Next j

    Next i



'hy Dizi_Sırala_______________________________________Bitti

If Kalan < 1 Then Exit Sub

Do While Kalan > 0 'kalan >0 olduğu sürece 1er 1er dağıtmak için

        For i = UBound(xDizi) To 0 Step -1 '

            CtlAdi = Mid(xDizi(i), 2, 1) 'hangi alan P1 mi p2 mi......

            CtlDeger = Mid(xDizi(i), 3) 'dizi değeri

            If Kalan = 0 Then Exit For

            If CtlDeger > 1 Then 'Px değeri 1 den büyükse

                Controls("R" & CtlAdi).Value = Nz(Controls("R" & CtlAdi).Value) + 1 'Rx'e 1 ekle

                Kalan = Kalan - 1 'kalanı azalt

            End If

            If CtlDeger = 1 And Nz(Controls("R" & CtlAdi).Value) = 0 Then 'Px=1 ve Rx=0 ise Rx'e 1 ekle

                Controls("R" & CtlAdi).Value = Nz(Controls("R" & CtlAdi).Value) + 1

                Kalan = Kalan - 1

            End If

            

        Next i

Loop

End Sub

teşekkürler berduş elinize sağlık. tam istediğim gibi..