sayıları rastgele dağıtmak

[Muhammet Okumuş]

sayıları rastgele dağıtmak

 

[Necdet]

Merhaba,

Belki daha kısa yolu vardır, yine de bir deneyiniz.

Sub Dagit()
Dim i, RasgeleSayı, NeKadar As Long
Dim Sayı As Integer
NeKadar = Application.WorksheetFunction.Sum(Range("B2:B" & [B65536].End(3).Row)) + 100
Application.ScreenUpdating = False
Columns("D:D").ClearContents
[D1] = "Sayılar"
For i = 2 To [A65536].End(3).Row
    Sayı = 0
    Do
        RastgeleSayı = Int((NeKadar * Rnd) + 1)
        If Cells(RastgeleSayı, "D") = "" Then
            Sayı = Sayı + 1
            Cells(RastgeleSayı, "D") = Cells(i, "A")
        End If
    Loop Until Sayı = Cells(i, "B")
Next i
Columns("D:D").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
Application.ScreenUpdating = True
MsgBox "Dağıtma İşlemi Bitmiştir....", vbOKOnly, "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
End Sub

 

[Ferhat Pazarçevirdi]

Aşağıdaki prosedürü, standart bir module sayfasına kopyalayıp, çalıştırınız.

Sub Sayilari_Rastgel_Dagit()
    Dim i As Integer
    Dim j As Integer
    Dim x As Integer
    Dim iSec As Integer
    Dim col As New Collection
    
[COLOR=darkgreen]    'bir collection nesnesine tüm veriler belirtilen miktar toplanıyor[/COLOR]
    On Error Resume Next
    
    For i = 1 To Cells(65536, 1).End(xlUp).Row
        If IsNumeric(Cells(i, 2)) Then
            If Cells(i, 2) > 0 Then
                For j = 1 To Cells(i, 2)
                    x = x + 1
                    col.Add Cells(i, 1), CStr(x)
                Next j
            End If
        End If
    Next i
    
    On Error GoTo 0
    
    Application.Calculation = xlCalculationManual
    
[COLOR=darkgreen]    'Collection nesnesinden rastgele veri çekilip sayfaya yazdırılıyor[/COLOR]
    For i = 1 To col.Count
        Randomize
fpc:
        iSec = CInt(Rnd() * col.Count)
        If iSec = 0 Then GoTo fpc
        
        Cells(i, 4) = col(iSec)
        col.Remove iSec
    Next i
    
    Application.Calculation = xlCalculationAutomatic
        
End Sub

 

[Muhammet Okumuş]

teşekkür ederim Necdet Bey

 

[Necdet]

Sayın muokumus,

Ferhat Bey'in çözümünü görmediniz sanırım.

 

[Muhammet Okumuş]

gördüm.uyguladım da ancak sayfa bom boş kaldı

 

[Necdet]

Merhaba,

Ferhat Bey'in kodlarını ben denedim gayet güzel çalışıyor.

 

[Muhammet Okumuş]

ben sadece kod görüntüle kısmına yapıştırdım.ama sayfa da birşey çıkmadı.zaten makrodan anlamıyorum.heralde bi yer de yanlışlık yapıyorum

 

[Necdet]

Bu mesajı okuyan insanların yanlış düşünmesini istemem.

Her iki kodun birleştirildiği dosyayı ekleme gereğini duydum.

 

[ahmett46]

slm hocam
dağıtma işlemini satırlara yerleştirebilirmiyiz?

 

[ahmett46]

dağıtılacak sayılar :a1,b1,c1.......
sayı adetleri :a2,b2,c2....... şeklinde olsun
sayıların dağıtılacağı yer: k2:ıv2 şeklinde olması mümkünmü? ayrıca adet kısmına 0(sıfır) yazdığımızda yada boş bıraktığımızda çalışmıyor bunu ekleyebilirmiyiz?