Sayıyı eşit olmayacak şekilde dağıtma

[keldorn]

Selamlar,

Excelde belirli bir sayıyı (mesela 100) değişken sayıdaki (20, 30 vb.) hücrelere eşit olmayacak şekilde (çan eğrisi oluşturacak şekilde) dağıtmak istiyorum.
Bunun için hangi formülü kullanabilirim ?
Yardımlarınız için şimdiden teşekkürler.

Mehmet

 

[Asri]

Formülsüz elle dağıtımı yapılmış örnek dosyanızı https://upterabit.com sitesinden yükleyip linki verebilir misiniz.
Site açıldığında kayıt OLMAYIN UPLOAD butonu ile dosyanızı yükleyin.

 

[keldorn]

upterabit.com/1Kzx/Deneme.xlsx

 

[Asri]

Menu makrosunu ana sayfada bir butona bağlayıp deneyiniz.

Eğri not ortalama işlerden pek anlamam ama anladığım kadarı ile

Sub menu()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   Call sayi_uret
   Call sirala
   Call yatay_diz
   Call kopyala
   If WorksheetExists("xxxxxxdenemexxxxx") Then Sheets("xxxxxxdenemexxxxx").Delete
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True

End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
   On Error Resume Next
   WorksheetExists = (Sheets(WorksheetName).Name <> "")
   On Error GoTo 0
End Function

Sub sayi_uret()
    
  If WorksheetExists("xxxxxxdenemexxxxx") Then Sheets("xxxxxxdenemexxxxx").Delete
  Set NewSh = Sheets.Add(After:=Sheets(Sheets.Count))
  NewSh.Name = "xxxxxxdenemexxxxx"
  
  Range("A1:Z1").Select
  Selection.ClearContents
  For i = 1 To 25
    Randomize
    sayi = Int(WorksheetFunction.RandBetween(1, 100))
    Cells(i, 1).Value = sayi / 100
  Next i
End Sub

Sub sirala()
    Range("A1:A12").Select
    ActiveWorkbook.Worksheets("xxxxxxdenemexxxxx").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("xxxxxxdenemexxxxx").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("xxxxxxdenemexxxxx").Sort
        .SetRange Range("A1:A12")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A13:A25").Select
    ActiveWorkbook.Worksheets("xxxxxxdenemexxxxx").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("xxxxxxdenemexxxxx").Sort.SortFields.Add Key:=Range("A13"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("xxxxxxdenemexxxxx").Sort
        .SetRange Range("A13:A25")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
End Sub


Sub kopyala()
    Range("A1:Y1").Select
    Selection.Copy
    Sheets("Sayfa3").Select
    Range("F13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E12").Select
End Sub

Sub yatay_diz()
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-12
    Range("B1").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
End Sub

 

[keldorn]

Tesekkurler elinize saglik.

Kodu calistirinca deneme dosyasindaki yerde rastgele olarak sayilar yazildi ancak sayilarin toplami 100 yapmiyor.
Bu islemi ln yapilacagi hucre sayisinigirerek yalnizca o kadar hucreye 100 degerini parabolik olarak dagitamazmiyiz?
Dagiliminda standart sapmasini belirleyebilirek cok guzrl olurdu.