İki sayı arasından rastgele sayı seçme (aynı sayıdan iki tane gelmeyecek şekilde)

[enveravsar]

Merhaba Arkadaşlar ben aşağıdaki şekilde 4000 ile 9000 arasından 200
sayı seçiyorum ama aynı sayıdan (10 civarı) iki adet getiriyor. Bunu nasıl engelleyebilirim.... teşekkürler.


Sub Unique_Numbers()
Dim x As Long, y As Long, z As Long, tempnum As Long
Dim flag As Boolean
Dim i As Integer
Dim foundCell As Range
Application.ScreenUpdating = False
x = Application.InputBox("Enter starting Random Number" _
, "Random Number Generation", 4000, , , , , 1)
y = Application.InputBox("Enter ending Random Number" _
, "Random Number Generation", 9000, , , , , 1)
z = Application.InputBox("How many random numbers would" _
& "you like to generate (<15000)?" _
, "Random Number Generation", 200, , , , , 1)
If z = 0 Then Exit Sub
If z > 15000 Then z = 15000
If z > y - x + 1 Then
MsgBox "You specified more numbers to return than " _
& "are possible in the range!"
Exit Sub
End If
Randomize
Cells(1, 1) = Int((y - x + 1) * Rnd + x)
For i = 2 To z
Do
flag = False
Randomize
tempnum = Int((y - x + 1) * Rnd + x)
Set foundCell = Range("a1", _
Range("a1").End(xlDown).Address).Find(tempnum)
If Not (foundCell Is Nothing) Then
flag = True
End If
Loop Until Not flag
Cells(i, 1) = tempnum
Next
End Sub

 

[Huseyinkis]

Merhaba Arkadaşlar ben aşağıdaki şekilde 4000 ile 9000 arasından 200
sayı seçiyorum ama aynı sayıdan (10 civarı) iki adet getiriyor. Bunu nasıl engelleyebilirim.... teşekkürler.

End Sub

Daha önce Levent MENTEŞOĞLU arkadaşımızın yayınladığı kodda değişiklikler yaptım sanırım işinizi gorur.

Sub sayiuret()
For a = 1 To 200
10 sayi = Int(Rnd() * 5001) + 4000
say = WorksheetFunction.CountIf([a1:A200], sayi)
If sayi > 9000 Or sayi = 0 Or say > 0 Then GoTo 10
Cells(a, 1) = sayi
Next
End Sub