Excel Forum


Geri Git   Excel Forum > EXCEL-Soruları > Beyin Fırtınası
Atatürk
Şifremi Unuttum

Beyin Fırtınası Bu başlıkta, ilginç olduğunu düşündüğünüz sorularınızı, bir problem şeklinde sorabilir, alternatif olduğunu düşündüğünüz çözümlerinizi paylaşabilirsiniz. (Bu başlıkta yeni konu açılması onaya bağlıdır.)
Dosya ekleyebilirsiniz

Özel Arama



Kapalı Konu
 
Paylaş Konu Araçları Görünüm Modları
Eski 15-11-2008, 17:48   #1
leumruk
Uzman
 
leumruk kullanıcısının avatarı
 
Giriş: 15/04/2007
Şehir: Mustafa ALTUN ÇANKIRI
Mesaj: 3,071
Excel Vers. ve Dili:
Office 2010 & 2013 tr
Varsayılan 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.
__________________
"Seni her türlü noksandan tenzih ederiz. Senin bize öğrettiğinden başka bizim hiçbir bilgimiz yoktur. Sen herşeyi hakkıyla bilir, her işi hikmetle yaparsın." (Bakara Sûresi: 2:32.)

"Onların duaları şu sözlerle sona erer: Ezelden ebede her türlü hamd ve övgü, şükür ve minnet, Âlemlerin Rabbi olan Allah'a mahsustur." (Yunus Suresi, 10:10.)
leumruk Çevrimdışı  
Eski 15-11-2008, 17:58   #2
Levent Menteşoğlu
Administrator
 
Levent Menteşoğlu kullanıcısının avatarı
 
Giriş: 13/10/2004
Şehir: Çorlu
Mesaj: 15,824
Excel Vers. ve Dili:
Excel 2010-Türkçe
Varsayılan

Sn leumruk

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



"Biz burada hep beraber, sevginin,saygının, alınterinin, mutluluğun makrosunu yazıyoruz. " Kaylan
Levent Menteşoğlu Çevrimdışı  
Eski 15-11-2008, 18:02   #3
leumruk
Uzman
 
leumruk kullanıcısının avatarı
 
Giriş: 15/04/2007
Şehir: Mustafa ALTUN ÇANKIRI
Mesaj: 3,071
Excel Vers. ve Dili:
Office 2010 & 2013 tr
Varsayılan

Olur hocam, nasıl uygun görürseniz. Hatta daha iyi olur. Bu bölüm çok yoğun, konu kaybolup gidebilir.
__________________
"Seni her türlü noksandan tenzih ederiz. Senin bize öğrettiğinden başka bizim hiçbir bilgimiz yoktur. Sen herşeyi hakkıyla bilir, her işi hikmetle yaparsın." (Bakara Sûresi: 2:32.)

"Onların duaları şu sözlerle sona erer: Ezelden ebede her türlü hamd ve övgü, şükür ve minnet, Âlemlerin Rabbi olan Allah'a mahsustur." (Yunus Suresi, 10:10.)
leumruk Çevrimdışı  
Eski 15-11-2008, 18:05   #4
Levent Menteşoğlu
Administrator
 
Levent Menteşoğlu kullanıcısının avatarı
 
Giriş: 13/10/2004
Şehir: Çorlu
Mesaj: 15,824
Excel Vers. ve Dili:
Excel 2010-Türkçe
Varsayılan

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



"Biz burada hep beraber, sevginin,saygının, alınterinin, mutluluğun makrosunu yazıyoruz. " Kaylan
Levent Menteşoğlu Çevrimdışı  
Eski 19-11-2008, 23:28   #5
xxcell
 
Giriş: 25/04/2007
Mesaj: 460
Excel Vers. ve Dili:
2007
Varsayılan

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
Eklenmiş Dosyalar
Dosya Türü: xls sayfa ustunde tombala ornegi.xls (29.5 KB, 946 Görüntülenme)
xxcell Çevrimdışı  
Eski 21-11-2008, 00:02   #6
Korhan Ayhan
Moderatör
 
Korhan Ayhan kullanıcısının avatarı
 
Giriş: 15/03/2005
Şehir: ANTALYA
Mesaj: 18,394
Excel Vers. ve Dili:
OFFICE 2003 PRO TR OFFICE 2013 PRO TR
Varsayılan

Selamlar,

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

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub RASTGELE_SAYI_ÜRET_1()
    [A1] = Int((100 * Rnd) + 1)
End Sub
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub RASTGELE_SAYI_ÜRET_2()
    [A1] = Evaluate("=RASTGELEARADA(1,100)")
End Sub

3. nolu sorunuzun cevabı;

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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
__________________
.
.
.

Soru sormadan önce forumumuzun aşağıdaki
bölümlerini incelediğinizde birçok sorunuza yanıt bulabilirsiniz.


Excel Dersanesi
Uygulamalı Excel Eğitimi
Excel İçin Örnek Uygulamalar
Video Dersane (***Altın Üyelere Özel***)

Lütfen sorularınızın çözümlendiğine dair geri dönüş mesajı yazınız...!
Lütfen yazım ve forum kurallarına uyalım...!
Lütfen sorularımızı açık ve net bir dille ifade edelim...!



FORUM KURALLARI
Korhan Ayhan Çevrimdışı  
Eski 21-11-2008, 07:17   #7
leumruk
Uzman
 
leumruk kullanıcısının avatarı
 
Giriş: 15/04/2007
Şehir: Mustafa ALTUN ÇANKIRI
Mesaj: 3,071
Excel Vers. ve Dili:
Office 2010 & 2013 tr
Varsayılan

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...
__________________
"Seni her türlü noksandan tenzih ederiz. Senin bize öğrettiğinden başka bizim hiçbir bilgimiz yoktur. Sen herşeyi hakkıyla bilir, her işi hikmetle yaparsın." (Bakara Sûresi: 2:32.)

"Onların duaları şu sözlerle sona erer: Ezelden ebede her türlü hamd ve övgü, şükür ve minnet, Âlemlerin Rabbi olan Allah'a mahsustur." (Yunus Suresi, 10:10.)
leumruk Çevrimdışı  
Eski 27-11-2008, 21:16   #8
leumruk
Uzman
 
leumruk kullanıcısının avatarı
 
Giriş: 15/04/2007
Şehir: Mustafa ALTUN ÇANKIRI
Mesaj: 3,071
Excel Vers. ve Dili:
Office 2010 & 2013 tr
Varsayılan

1-9 ARASINDA 5 ayrı hücrede Rastgele sayı üretir.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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.
Eklenmiş Dosyalar
Dosya Türü: xls Randomize.xls (97.0 KB, 512 Görüntülenme)
__________________
"Seni her türlü noksandan tenzih ederiz. Senin bize öğrettiğinden başka bizim hiçbir bilgimiz yoktur. Sen herşeyi hakkıyla bilir, her işi hikmetle yaparsın." (Bakara Sûresi: 2:32.)

"Onların duaları şu sözlerle sona erer: Ezelden ebede her türlü hamd ve övgü, şükür ve minnet, Âlemlerin Rabbi olan Allah'a mahsustur." (Yunus Suresi, 10:10.)

Bu mesaj en son " 27-11-2008 " tarihinde saat 21:25 itibariyle leumruk tarafından düzenlenmiştir....
leumruk Çevrimdışı  
Eski 27-11-2008, 21:45   #9
Taruz
Uzman
 
Taruz kullanıcısının avatarı
 
Giriş: 18/04/2007
Şehir: İstanbul
Mesaj: 2,058
Excel Vers. ve Dili:
Access 2010
Varsayılan

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.
Taruz Çevrimdışı  
Eski 28-11-2008, 00:27   #10
Ferhat Pazarçevirdi
 
Ferhat Pazarçevirdi kullanıcısının avatarı
 
Giriş: 15/06/2006
Şehir: İzmir
Mesaj: 3,718
Excel Vers. ve Dili:
Excel 2003, 2007, 2010 (TR)
Varsayılan

Alıntı:
Taruz tarafından gönderildi Mesajı Görüntüle
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 ...
__________________
Bugün pazar. | Bugün beni ilk defa güneşe çıkardılar. | Ve ömrümde ilk defa gökyüzünün | bu kadar benden uzak | bu kadar mavi | bu kadar geniş olduğuna şaşarak | kımıldamadan durdum. | Sonra saygıyla toprağa oturdum, | dayadım sırtımı duvara. | Bu anda ne düşmek dalgalara, | bu anda ne kavga,ne hürriyet, ne karım. | Toprak, güneş ve ben | Bahtiyarım| NAZIM/1938
www.xlchart.blogspot.com
Ferhat Pazarçevirdi Çevrimdışı  
Kapalı Konu


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 03:59


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.


Bahis Forum - Termal Kemer - Define - Samsung Fernseher - Plastik - Excel Eğitim - Çorlu Kamera - Kırklareli Kız Yurdu - Kırklareli Kız Apart - Yurt Kırklareli - Kız Yurdu Kırklareli - Kız Öğrenci Yurdu Kırklareli - Kız Öğrenci Apart - Kırklareli Sembol - Kırklareli Pansiyon - Kırklareli Kız Apart - Kırklareli Kız Apart - Kırklareli Apart - Kırklareli Yurt - Kırklareli Kız Yurdu - Çorlu Demir Çelik - Kırklareli Kız Öğrenci - Çorlu Petek Temizleme
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden