Makro ile rastgele sayı seçmek

[arda41]

Merhaba Arkadaşlar,

Forumda aratmama rağmen ekteki excelde ayrıntılı şekilde anlattığım, listeden rastgele sayı seçme problemime makro bilgim yetersiz olduğu için çözüm bulamadım.

Yardımcı olabilecek herkese şimdiden çok teşekkür ederim.
Saygılarımla

 

[Muhammet Okumuş]

Merhaba,

Sub Rastgele()
Range("F:F") = ""
For i = 1 To Range("D1")
10
Randomize
son = Cells(Rows.Count, 1).End(3).Row
a = Int(Rnd() * son) + 1
If WorksheetFunction.CountIf(Range("F:F"), Cells(a, 1)) = 1 Then GoTo 10
Cells(i, 6) = Cells(a, 1).Value
Next
End Sub

Kodu deneyiniz.

 

[Orion1]

Dosyanız ektedir.

Sub rastgele59()
Dim don As Integer, say As Integer, i As Long, sonsat As Long
Dim col As Object
Randomize Timer
Sheets("sayfa1").Select
Range("F:F").ClearContents
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
Set col = New Collection
For i = 1 To sonsat
col.Add Cells(i, "A").Value
Next i
don = Range("D1").Value
For i = 1 To don
    son = col.Count
    indis = CInt(Int(Rnd() * son) + 1)
    Cells(i, "F").Value = col(indis)
    col.Remove (indis)
Next
    
End Sub

 

[Necdet]

Merhaba,

Muhammet bey yanıtlamış, alternatif olsun.

Belki benzer sayı seçmek istemezseniz aşağıdaki kodları deneyiniz.

Sub Seç()

    Dim i   As Long, _
        j   As Long, _
        s   As Long, _
        c   As Range
        
    i = Cells(Rows.Count, "A").End(3).Row
    Randomize
    Range("G:G").ClearContents
    
    Do
        s = Int((i * Rnd) + 1)
        Set c = Range("G:G").Find(s, LookIn:=xlValues)
        If c Is Nothing Then
            j = j + 1
            Cells(j, "G") = Cells(s, "A")
        End If

    Loop While j < Range("D1")
    
End Sub

 

[arda41]

Sayın Muhammet Okumuş
Sayın Orion1
Sayın Necdet Yeşertener

İlgi ve yardımınız için çok teşekkürler.
Saygılarımla