İstenen aralıkta , istenen kadar sayı üret

Katılım
28 Haziran 2006
Mesajlar
7
Merhaba arkadaşlar ;

A1 : A30 aralığına 1 ile 60 arasında ( 1 , 60 dahil ) , 30 tane birbirine eşit olmayan sayıyı bir buton yardımıyla nasıl yazdırabilirim ?

Teşekkürler.
 
Katılım
28 Haziran 2006
Mesajlar
7
vermiş olduğunuz kod hep aynı sayıları üretiyor.Benim istediğim şey tam olarak şu :

A1:A30 aralığına 60 a kadar olan sayılardan 30 tanesini rastgele yazsın.Ama butona her tıkladığımda farklı bir 30 sayı oluşsun.Ve her tıkladığımda önceki oluşan sayılar silinsin yerine yenileri oluşsun.

İlgin için teşekkürler.
 

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,369
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
Kod:
Sub sayi_uret()
Randomize
    While i <= 30
        sayi = Int(Rnd(59) * 60 + 1)
        If WorksheetFunction.CountIf([a1:a30], sayi) = 0 Then
            i = i + 1
            Cells(i, 1) = sayi
        End If
    Wend
End Sub
 
Son düzenleme:
Katılım
28 Haziran 2006
Mesajlar
7
say&#305;n anemos ;

vermi&#351; oldu&#287;unuz kod da &#252;retilen 30 say&#305; i&#231;erisinde AYNI say&#305;lar yer alabiliyor.Benim istedi&#287;im ayn&#305; say&#305;lar olmas&#305;n ?

Te&#351;ekk&#252;rler
 

Ali

Özel Üye
Katılım
21 Temmuz 2005
Mesajlar
7,919
Excel Vers. ve Dili
İş:Excel 2016-Türkçe
kod da üretilen 30 sayı içerisinde AYNI sayılar yer alabiliyor.Benim istediğim aynı sayılar olmasın ?

Teşekkürler

Kod:
Dim rastgele_no(60) As Variant
Sub rastgelesayiuret()
Randomize
Range("A1:A30").ClearContents
say = 1
Do Until say = 31
    yeni_numara = Int(Rnd() * (60 - 1) + 1)
    If rastgele_no(yeni_numara) <> "onceki" Then
        Range("A" & say).Value = yeni_numara
        rastgele_no(yeni_numara) = "onceki"
        say = say + 1
    End If
Loop
End Sub
 
Katılım
15 Ocak 2007
Mesajlar
791
Excel Vers. ve Dili
2003 excel visual basic
kullanıcı tanımlı

ekte kullanıcı tanımlı bir döngü var inceler misin??
 
Katılım
28 Haziran 2006
Mesajlar
7
Merhaba say&#305;n ALi ;

Vermi&#351; oldu&#287;unuz KOD i&#351;imi g&#246;r&#252;yor ama bir kez t&#305;klay&#305;nca butona excel hata veriyor.Kapan&#305;yor.Acaba neden ? Sayg&#305;lar
 

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,369
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
Yukardaki kodu g&#252;ncelledim. Dener misiniz?
 
Katılım
28 Haziran 2006
Mesajlar
7
Te&#351;ekk&#252;rler Anemos ;

&#350;imdi istedi&#287;im gibi oldu. Sayg&#305;lar

&#304;yi &#231;al&#305;&#351;mlar...
 

Ali

Özel Üye
Katılım
21 Temmuz 2005
Mesajlar
7,919
Excel Vers. ve Dili
İş:Excel 2016-Türkçe
&#350;u &#351;ekildede kullanabilirsiniz

Kod:
Sub say&#305;uret()
Range("A1:A30").ClearContents
For i = 1 To 30
Do
sayilar = Int(60 * Rnd + 1)
If Range("A1:A30").Find(sayilar, LookAt:=xlWhole) Is Nothing Then Exit Do
Loop
Range("A1:A30").Cells(i, 1) = sayilar
Next i
End Sub
 
Son düzenleme:

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,649
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub SayiUret()
 Range("A1:A30").ClearContents
Dim dizi(1 To 60)

For x = 1 To 60
    dizi(x) = x
Next x

Randomize Timer
For x = 1 To 30
basla:
    ind = Int(Rnd * 60) + 1
    If ind = 0 Or ind = 61 Then GoTo basla
    ara = dizi(x)
    dizi(x) = dizi(ind)
    dizi(ind) = ara
Next x
    
For x = 1 To 30
    Cells(x, 1) = dizi(x)
Next x
Range("A1:A30").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess


End Sub
 
Üst