Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Beyin Fırtınası (http://www.excel.web.tr/forumdisplay.php?f=142)
-   -   Rastgele Sayı Üretme! (http://www.excel.web.tr/showthread.php?t=58558)

leumruk 15-11-2008 18:48

Rastgele Sayı Üretme!
 
Değerli Arkadaşlar,
Malum bu konuda pek çok soru geliyor. Benim bir önerim olacak, bu başlık altında bu konuyla ilgili kodları ekleyebilir miyiz? Alternatifler bir başlık altında toplanırsa hangisini kullanacağımıza daha iyi karar verebiliriz.
Ben bu konuyla ilgili gelen ve gelebilecek soruları sıralamaya çalışayım:
1. A1 hücresine 1-100 arasında rastgele sayı üretme.
2. A1 hücresine 1-100 arasında rastgele sayı üretme. 100 sayı tekrarlanana kadar aynı sayı yeniden gelmeyecek. Bittiğinde çekilişin bittiği uyarısını verecek.
3. A1-A100 arası tekrarsız rastgele sayı üretme.
4. A1:A50 arasında yazılı rastgele sayıları B1:B50 arasına rastgele sıralama.
5. A1:A50 arasındaki hücrelerden birini rastgele seçme.
6. A1:A50 arasındaki hücreleri rastgele seçme, seçtiğini bir daha seçmeme.

Şu an aklıma gelenler bunlar, elinde veri olan arkadaşlar paylaşırsa memnun olurum.
Burada olmayıp da aklınıza gelen konuyla ilgili bildiklerinizi de paylaşırsanız, sevinirim.
katkısı olacak arkadaşlara şimdiden teşekkürler.

Levent Menteşoğlu 15-11-2008 18:58

Sn leumruk

Bu konuyu bence Beyin Fırtınası başlığına taşıyalım ilgilenen üyelerimiz konu üzerindeki önerilerini paylaşsın.

leumruk 15-11-2008 19:02

Olur hocam, nasıl uygun görürseniz. Hatta daha iyi olur. Bu bölüm çok yoğun, konu kaybolup gidebilir.

Levent Menteşoğlu 15-11-2008 19:05

Güzel bir konu bu başlıkta arada kaynamayacaktır. Tüm üyelerimizden ilginç öneriler bekliyoruz.

xxcell 20-11-2008 00:28

1 Eklenti(ler)
2 numaralı soru bana Tombalayı anımsattı.

Bende (konsepti bozmadan!) 2 numaralı soruya cevaben bir örnek hazırladım.

İlginize sunarım, teşekkürler ;)

Korhan Ayhan 21-11-2008 01:02

Selamlar,

1. nolu sorunuzun cevabı; (İki alternatif)

Kod:

Sub RASTGELE_SAYI_ÜRET_1()
    [A1] = Int((100 * Rnd) + 1)
End Sub

Kod:

Sub RASTGELE_SAYI_ÜRET_2()
    [A1] = Evaluate("=RASTGELEARADA(1,100)")
End Sub


3. nolu sorunuzun cevabı;

Kod:

Sub RASTGELE_SAYI_ÜRET_3()
    Dim X As Byte, SAYI As Byte
 
    Columns(1).ClearContents
    For X = 1 To 100
BAŞLA: SAYI = Int((100 * Rnd) + 1)
    If WorksheetFunction.CountIf(Columns(1), SAYI) > 0 Or SAYI = 0 Then GoTo BAŞLA
    Cells(X, 1) = SAYI
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub


4. nolu sorunuzun cevabı;

Kod:

Sub RASTGELE_SAYI_ÜRET_4()
    Dim X As Byte, SAYI As Byte
 
    Columns(2).ClearContents
    For X = 1 To 50
BAŞLA: SAYI = Int((50 * Rnd) + 1)
    If SAYI = 0 Then GoTo BAŞLA
    If Cells(SAYI, 2) = Empty Then
    Cells(SAYI, 2) = Cells(X, 1)
    Else
    GoTo BAŞLA
    End If
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub


5. nolu sorunuzun cevabı;

Kod:

Sub RASTGELE_HÜCRE_SEÇ_5()
    Dim X As Byte, SAYI As Byte
 
BAŞLA: SAYI = Int((50 * Rnd) + 1)
    If SAYI = 0 Then GoTo BAŞLA
    Cells(SAYI, 1).Select
End Sub


6. nolu sorunuzun cevabı;

Kod:

Sub RASTGELE_HÜCRE_SEÇ_6()
    Dim X As Byte, SAYI As Byte
 
BAŞLA: SAYI = Int((50 * Rnd) + 1)
    If SAYI = 0 Then GoTo BAŞLA
    If SAYI <> ActiveCell.Row Then
    Cells(SAYI, 1).Select
    Else
    GoTo BAŞLA
    End If
End Sub


leumruk 21-11-2008 08:17

Korhan Hocam,
Teşekkür ederim. Çok güzel bir kaynak oldu.
Bir kaç tane daha aklıma konu geldi:
1. A1: A10 arasındaki hücrelerde bulunan verileri kendi içinde rastgele karıştırma.
2. Aynı şekilde yan yana bulunan birden fazla sütunda bulunan verileri dağılım düzeni birbiriyle aynı olmayacak şekilde rastgele dağıtma.
Syn. Hocam bunlarında çözümü var mı?
Bunların dışında aklınıza gelen başka rastgele dağılım biçimleri varsa, eklerseniz sevinirim.
Saygılar...

leumruk 27-11-2008 22:16

1 Eklenti(ler)
1-9 ARASINDA 5 ayrı hücrede Rastgele sayı üretir.
Kod:

Sub Makro1()
    [B3] = "=INT((RAND()*9)+1)"
    [c3] = "=INT((RAND()*9)+1)"
    [D3] = "=INT((RAND()*9)+1)"
    [e3] = "=INT((RAND()*9)+1)"
    [F3] = "=INT((RAND()*9)+1)"
End Sub

1-10 arasında benzersiz sayı üretir. 10 sayının 10'u da farklıdır.
A1'den başlayarak sırayla tek tek üretir.
Her denemede hücreleri boşaltmanız gerekmektedir.
Kod:

Sub RASTGELE_SAYI()
    SÜTUN = [IV1].End(1).Column
    If SÜTUN = 10 Then Exit Sub
BAŞLA:
    sayi = Int((10 * Rnd) + 1)
    If WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(1, SÜTUN + 1)), sayi) > 0 Or sayi = 0 Then GoTo BAŞLA
    If Cells(1, SÜTUN) <> "" Then
    Cells(1, SÜTUN + 1) = sayi
    Else
    Cells(1, SÜTUN) = sayi
    End If
End Sub

A sütununa son sınırı 60 olmak üzere 30 tane farklı sayı üretir.
Kod:

Sub sayi_uret()
Randomize
    While i <= 29
        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

A1 hücresine 1-100 arasında rastgele sayı üretir.
Kod:

Sub sayi()
[a1] = Int(Rnd * 100)
End Sub

5 sütun ve 5 satırda yan yana ve alt alta aynı sayılar denk gelmeyecek şekilde rastgele sayı üretir.
Kod:

Sub random() 'Aynı sayı denk gelmez. 5 sütunda birden üretir. Satır sütun hiçbiri çakışmaz.
For i = 1 To 5
For y = 1 To 5
10 bul = Int(Rnd * 12) + 1
If WorksheetFunction.CountIf(Columns(y), bul) > 0 Then GoTo 10
If WorksheetFunction.CountIf(Rows(i), bul) > 0 Then GoTo 10
Cells(i, y) = bul
Next: Next
End Sub

10 satırda birbirinden farklı 10 sayı üretir.
Kod:

Sub benzersiz_rastgele()
Dim arr() As Long
Min = "1" 'minimum değer
Max = "10" 'maksimum değer
ReDim arr(Max - Min)
say = 0
For i = Min To Max
arr(say) = i
say = say + 1
Next

For j = 0 To UBound(arr)
x = Int(((Max - Min) * Rnd))
temp = arr(x)
arr(x) = arr(j)
arr(j) = temp
Next j
For i = 0 To UBound(arr)
Cells(i + 1, 1) = arr(i)
Next

1-9 arasında rastgele sayı üretir.
Kod:

Sub Benzersiz()
10 sayi = Int(Rnd * 10)
If sayi < 1 Or sayi = [a1] Then GoTo 10
[a1] = sayi
End Sub

4 basamaklı rastgele sayı üretir.
Kod:

Sub BasamakFarklı()
10 say1 = Int(Rnd * 10)
If say1 = 0 Then GoTo 10
20 say2 = Int(Rnd * 10)
If say2 = say1 Then GoTo 20
30 say3 = Int(Rnd * 10)
If say3 = say1 Or say3 = say2 Then GoTo 30
40 say4 = Int(Rnd * 10)
If say4 = say1 Or say4 = say2 Or say4 = say3 Then GoTo 40
[a1] = say1 & say2 & say3 & say4
End Sub

Kodlarda kayıtlı isimleri rastgele seçip A1 hücresine yazar.
Kod:

Sub İsimSeç()
deg = Array("osman", "ali", "haluk", "levent", "sinan", "ayşe", "fatma", "caner", "cafer", "cengiz")
[a1] = deg(Int(Rnd() * 10))
End Sub

A sütunundaki isimlerden rastgele seçer; C1'e yazar.
Kod:

Sub MetinSeç()
For i = 1 To 10
Cells(i, 3) = Cells(Int(Rnd() * 10) + 1, "A")
Exit Sub
Next
End Sub

Hücredeki kelimelerin yerlerini rastgele değiştirir.
Kod:

Sub siradegistir()
20 deg = Split([a1], " ")
metin = ""
say = WorksheetFunction.CountA([a:a])
If say = WorksheetFunction.Fact(UBound(deg) + 1) Then
MsgBox "Tüm ihtimaller çıkmıştır."
Exit Sub
End If
For a = 1 To UBound(deg) + 1
10 sayi = Int(Rnd * (UBound(deg) + 1))
If InStr(metin, deg(sayi)) > 0 Then GoTo 10
metin = metin & " " & deg(sayi)
Next
If WorksheetFunction.CountIf([a:a], LTrim(metin)) > 0 Then GoTo 20
Range("a65536").End(3).Offset(1, 0) = LTrim(metin)
End Sub

Kaynak: excel.web.tr
İlerleyen zamanlarda yeni randomize kodlar ekleyeceğim.
Yazılı kodların örnekleri ekli dosyada mevcuttur. Her kod kendi sayfasına yazılmıştır.

Taruz 27-11-2008 22:45

Merhaba..

Paylaşımlarınız için teşekkür ederim. Çok güzel gerçekten.

Rastgele sayı ile ilgili geçen forumda güzel bir soruya denk gelmiştim. Makro forumundaydı yanılmıyorsam..

Sayın leumruk'un sorularına ilave olabileceğini düşünüyorum..

Soru :

Rastgele 50 satır sayı üretelim ama ondalıklı. Bunlar 4 ile -4 arasında ve benzersiz olsun. Toplamıda 30 olsun..

Güzel soru bence.. Tabii taktir sizin yinede.

Ferhat Pazarçevirdi 28-11-2008 01:27

Alıntı:

Taruz tarafından gönderildi (Mesaj 323389)
Merhaba..

Paylaşımlarınız için teşekkür ederim. Çok güzel gerçekten.

Rastgele sayı ile ilgili geçen forumda güzel bir soruya denk gelmiştim. Makro forumundaydı yanılmıyorsam..

Sayın leumruk'un sorularına ilave olabileceğini düşünüyorum..

Soru :

Rastgele 50 satır sayı üretelim ama ondalıklı. Bunlar 4 ile -4 arasında ve benzersiz olsun. Toplamıda 30 olsun..

Güzel soru bence.. Tabii taktir sizin yinede.

Sn.Taruz

Bu fırtına değil, resmen kasırga olmuş :)

Hem 50 tane olacak, hem pozitif veya negatif olacak, üstüne üstlük toplamları +30 olacak ... Vallahi, Mars bile bundan daha ağır koşullarda oluşmamıştır ... Sonucu veren sayıları bulma ihtimali de -bizim PC'lerde- sanırım, evrim süresini aşar :)

Sevgiler ...


Saat 09:56

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.