• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Rastgele Sayı Üretmede Benzerlik

  • Konbuyu başlatan Konbuyu başlatan HASAN40
  • Başlangıç tarihi Başlangıç tarihi
Katılım
18 Ekim 2010
Mesajlar
215
Excel Vers. ve Dili
Microsoft Excel 03,07
Merhaba arkadaşlar,

Forumda araştırma yaptım ve sorunumla ilgili bazı çözümler buldum fakat bunu kendi çalışmama uyarlayamadım. Aşağıda vermiş olduğum kodlarla, belirlediğim (A8,A10,A12,A14) hücrelere 1 ile 4 arasında rastgele sayı yazdırabiliyorum. Ancak bu sayıların benzersiz olmasını bir türlü sağlayamadım. Workdsheetfunction.countif komutu ile denedim ancak A8 hücresinde sürekli bi döngüye sebep oldu ve esc yapmadan da excel sürekli çalıştı esc ye bastığımda ise kritik hata verip programı yani exceli kapadı. Şimdiden yardımlarınız için çok teşekkür ederim...

Kod:
Sub rastgelesayi()
Dim h As Byte
Cells(8, 1) = "": Cells(10, 1) = "": Cells(12, 1) = "": Cells(14, 1) = ""
For h = 8 To 14 Step (2)
    Cells(h, 1) = Int((Rnd * 4) + 1)
Next
MsgBox "İşlem tamam...", vbInformation
End Sub
 
Merhaba arkadaşlar,

Forumda araştırma yaptım ve sorunumla ilgili bazı çözümler buldum fakat bunu kendi çalışmama uyarlayamadım. Aşağıda vermiş olduğum kodlarla, belirlediğim (A8,A10,A12,A14) hücrelere 1 ile 4 arasında rastgele sayı yazdırabiliyorum. Ancak bu sayıların benzersiz olmasını bir türlü sağlayamadım. Workdsheetfunction.countif komutu ile denedim ancak A8 hücresinde sürekli bi döngüye sebep oldu ve esc yapmadan da excel sürekli çalıştı esc ye bastığımda ise kritik hata verip programı yani exceli kapadı. Şimdiden yardımlarınız için çok teşekkür ederim...
Merhaba.
Aşağıdaki gibi olabilir..

Kod:
Sub rastgelesayi()
Dim h As Byte
Cells(8, 1) = "": Cells(10, 1) = "": Cells(12, 1) = "": Cells(14, 1) = ""
For h = 8 To 14 Step (2)
a:
Cells(h, 1) = Int((Rnd * 4) + 1)
   If WorksheetFunction.CountIf(Range("a8:a14"), Cells(h, 1)) > 1 Then
   Cells(h, 1) = ""
   GoTo a
   End If
Next
MsgBox "İşlem tamam...", vbInformation
End Sub
 
Merhaba Sayın Husgvarna;
Hem sorunumu çözdünüz hem de bana ışık oldunuz. Çok teşekkür ederim...
 
Geri
Üst