Rastgele Sayı Üretme!

[leumruk]

Selamlar,

Sub uret()
If [a1] = "" Or [a2] = "" Or [a3] = "" Then
MsgBox "Kriter kısmını boş bırakamazsınız. [a1:a3] arasını kontrol ediniz."
Exit Sub
End If
If [a2] < [a3] Then
MsgBox "a2'ye girdiğiniz veri a3'ten küçük olamaz."
Exit Sub
End If
Sat = [c65536].End(3).Row + 1
If WorksheetFunction.CountA(Range(Cells(1, "c"), Cells(Sat - 1, "c"))) = [a3] Then
MsgBox "Kura çekimi tamamlandı."
Exit Sub
End If
Randomize
BASLA:
If [c1] = "" Then Sat = 1
Sayi = Int(Rnd * [a2].Value + 1)
If Sayi < [a1] Then GoTo BASLA
If WorksheetFunction.CountIf(Range(Cells(1, "c"), Cells(Sat, "c")), Sayi) Then GoTo BASLA
Cells(Sat, "c") = Sayi
End Sub

 

[Muhammet Okumuş]

1-acaba tek tuşla bütün sayıları üretmek için ne yapmalıyız ?
2-bir kez bastığımda sayılar c sütununda oluşuyor.bir daha bastığımda d bir daha bastığımda e sütununda .....
bu şekilde kod yazabilirmiyiz?

 

[leumruk]

çok teşekkürler
yalnız a3=üretilecek sayı miktarını değiştirmemize rağmen
hep 5 defa sayı üretiliyordu
If WorksheetFunction.CountA(Range(Cells(1, "c"), Cells(Sat - 1, "c"))) = [a3] Then
MsgBox "Kura çekimi tamamlandı."
burayı inceleyerek 5 yazan yere kırmızı ile gösterdiğim a3 girerek tamamlamış oldum.
sayende baya birşeyler öğreniyorum, tekrar teşekkürlerrr

acaba tek tuşla bütün sayıları üretmek için ne yapmalıyız ?

Uyarı için teşekkürler, 5 ile deneme yaptığım için [a3]'ü yazmayı unutmuşum. İlgili kodları ve dosyayı güncellledim.
Aşağıdaki kodlarla, sayıları bir anda üretebilirsiniz.

Sub uret()
If [a1] = "" Or [a2] = "" Or [a3] = "" Then
MsgBox "Kriter kısmını boş bırakamazsınız. [a1:a3] arasını kontrol ediniz."
Exit Sub
End If
If [a2] < [a3] Then
MsgBox "a2'ye girdiğiniz veri a3'ten küçük olamaz."
Exit Sub
End If
For i = 1 To [a3]
Randomize
BASLA:
If [c1] = "" Then Sat = 1
Sayi = Int(Rnd * [a2].Value + 1)
If Sayi < [a1] Then GoTo BASLA
If WorksheetFunction.CountIf(Range(Cells(1, "c"), Cells(i, "c")), Sayi) Then GoTo BASLA
Cells(i, "c") = Sayi
Next i
End Sub

 

[leumruk]

1-acaba tek tuşla bütün sayıları üretmek için ne yapmalıyız ?
2-bir kez bastığımda sayılar c sütununda oluşuyor.bir daha bastığımda d bir daha bastığımda e sütununda .....
bu şekilde kod yazabilirmiyiz?

Aşağıdaki kodu deneyin.

Sub Calistir()
If [n2] > 11 Then Exit Sub
Sut = Cells(1, [n2]).End(1).Column + 1
If Cells(1, 1) = "" Then Sut = 1
Randomize
For i = 1 To [n1]
BASLA:
Sayi = Int(Rnd * [n1] + 1)
If WorksheetFunction.CountIf(Range(Cells(1, Sut), Cells([n1], Sut)), Sayi) > 0 Then GoTo BASLA
Cells(i, Sut) = Sayi
Next i
If Cells(1, [n2]) <> "" Then
Sor = MsgBox("Tüm sütunlar dolmuştur. İşleme yeniden başlamak istiyor musunuz?", vbQuestion + vbYesNo, "UYARI")
If Sor = vbNo Then Exit Sub
If Sor = vbYes Then
Range("a:k") = ""
Exit Sub
End If
End If
End Sub

 

[Levent Menteşoğlu]

Değerli arkadaşlar

Biliyorsunuz bu başlık soru-cevap amaçlı değildir. Bu sebeple, eğer bu konu üzerinde sorularınız mevcutsa, makro-vba ana başlığında yeni bir başlık açarak paylaşımlarınızı burada devam ettirmenizi rica ederim.

 

[Muhammet Okumuş]

Sn leumruk hocam çok güzel omuş.peki ben bir sütunda 10 a kadar 30 tane sayı üretmek istiyorum.yani aynı sayılar gelebilir.bir tane kod buldum ancak dosyayı açtığımda hep aynı sayıları üretiyor

 

[Levent Menteşoğlu]

Değerli arkadaşlar

Biliyorsunuz bu başlık soru-cevap amaçlı değildir. Bu sebeple, eğer bu konu üzerinde sorularınız mevcutsa, makro-vba ana başlığında yeni bir başlık açarak paylaşımlarınızı burada devam ettirmenizi rica ederim.

Tekrar hatırlatmam gerekiyor sanırım.

 

[Muhammet Okumuş]

Pardon Levent Bey
Ben mesajınızı görmemiştim.Ama bu konu ile çok soru sorulduğu için bence konuyu makro-vba olarak değiştirmek daha iyi olur.aksi takdirde sürekli konu açılır ve konular dağılmış olur.

 

[Levent Menteşoğlu]

Pardon Levent Bey
Ben mesajınızı görmemiştim.Ama bu konu ile çok soru sorulduğu için bence konuyu makro-vba olarak değiştirmek daha iyi olur.aksi takdirde sürekli konu açılır ve konular dağılmış olur.

Bu konudaki kararı Sn Mustafa bey verecektir. Eğer kendisi arzu ederse konuyu makro-vba başlığına taşıyabiliriz.

 

[leumruk]

Bu konudaki kararı Sn Mustafa bey verecektir. Eğer kendisi arzu ederse konuyu makro-vba başlığına taşıyabiliriz.

Syn. Levent Bey,
Öncelikle kararı bana bırakarak gösterdiğiniz inceliğe teşekkür ederim. Yeni başlık açma konusundaki uyarınıza katılmakla beraber, bu başlığın bu bölümde sabit kalmasının daha uygun olacağını düşünüyorum. Aksi takdirde kaybolup gidecektir, bu bölümde göz önünde olması daha iyi.

Syn. muokumuş, bu bölümde soru cevap yapıldığında konu çok fazla şişiyor ve gereksiz bir çok mesajla doluyor. Sonrasında aradığımızı bulmakta yine zorlanmaya başlıyoruz. Siz yeni bir başlık açın. Ben zaten farklı bulduğum uygulamaları buraya açıklamasını yaparak ekliyorum. Yani size verdiğim cevabın son halini buraya ekleyeceğim. Böylece belki 10 mesaja yayılacak konuyu bir mesajla buraya ekleyerek, hem yeni konunun kaybolmasını engellemiş oluruz, hem de bu bölümün şişmesine engel oluruz.
Saygılar...

 

[Levent Menteşoğlu]

Syn. Levent Bey,
Öncelikle kararı bana bırakarak gösterdiğiniz inceliğe teşekkür ederim. Yeni başlık açma konusundaki uyarınıza katılmakla beraber, bu başlığın bu bölümde sabit kalmasının daha uygun olacağını düşünüyorum. Aksi takdirde kaybolup gidecektir, bu bölümde göz önünde olması daha iyi.

Syn. muokumuş, bu bölümde soru cevap yapıldığında konu çok fazla şişiyor ve gereksiz bir çok mesajla doluyor. Sonrasında aradığımızı bulmakta yine zorlanmaya başlıyoruz. Siz yeni bir başlık açın. Ben zaten farklı bulduğum uygulamaları buraya açıklamasını yaparak ekliyorum. Yani size verdiğim cevabın son halini buraya ekleyeceğim. Böylece belki 10 mesaja yayılacak konuyu bir mesajla buraya ekleyerek, hem yeni konunun kaybolmasını engellemiş oluruz, hem de bu bölümün şişmesine engel oluruz.
Saygılar...

Sn Mustafa bey

Öneriniz yerinde bir öneridir. Bencede böylesi daha uygun olacaktır.

 

[leumruk]

10 Sütunda farklı kombinasyonlar

Selamlar,
Eklediğim dosyada, 5 satır, 10 sütunda bulunan veriler, olabilecek bütün farklı kombinasyonlarda karışmaktadır. Her sütun kendi içinde farklı kombinasyon oluşturur. Çıkan kombinasyonlar, sayfa2'de sıralanır.
NOT: Bu program sayı üretme programı değil, hücre içindeki verileri karıştırmaya yarayan bir programdır. Hücreye hangi veriyi girerseniz, o veriler karışır. Sayı ya da metin farketmez.

 

[adslboy]

Selamlar,
Eklediğim dosyada, 5 satır, 10 sütunda bulunan veriler, olabilecek bütün farklı kombinasyonlarda karışmaktadır. Her sütun kendi içinde farklı kombinasyon oluşturur. Çıkan kombinasyonlar, sayfa2'de sıralanır.
NOT: Bu program sayı üretme programı değil, hücre içindeki verileri karıştırmaya yarayan bir programdır. Hücreye hangi veriyi girerseniz, o veriler karışır. Sayı ya da metin farketmez.

Sayin leumruk,

Emeginize Tesekurler

 

[kazablanka222]

Merhaba arkadaşlar forumda vermiş olduğunuz bilgiler gerçekten çok faydalı emeği geçen herkese canı gönülden teşekkür ederim. Bu hususta benimde bir sorum olacak. Random fonksiyonunu kullanmadan 1 den n' e kadar olan sayıları kendi içinde nasıl karıştırabilirim.

ilginize şimdiden teşekkür ederim.

 

[olixi]

arkadaşlar bu konu devam ediyor mu yardıma ihtiyacım var biraz zahmetli bir uğraş gibi ama yapabilcek bir arkadaş var mı acaba:?

 

[scpicak]

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

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

QUOTE]

Örneğin 10 farklı sayının (mesela) 100 sayı arasından seçilmesi durumunda nasıl olur peki?
100 sayı arasından seçilen 10 sayı bir sütun halinde yazdırılabilir mi?

Şimdiden çok teşekkürler,

Selamlar

 

[scpicak]

arkadaşlar dosyada belirli sayılar arasında zayı üreten çalışma kitabı yer alıyor.butona bir kez bastığımda sayıları hemen sıralıyor.sizden istediğin hemen değil her basışta bir sayı seçmesini istiyorum.

Arkadaşlar benim söylemek istediğim şeyi muokumus yapmıs sağolsun.

Zamanınızı boşa harcamak istemem...

Hepinize çok teşekkürler

 

[msanli]

Merhaba. Üzerinde çalıştığım bir proje için bu rastgele sayılar üretmek istiyorum. Fakat, buradaki örneklerin tamam ondalık olmadan yapılmış. Ben ise, iki değer verip arasında en az 20 değer üretmek istiyorum.

Örneğin: 10.03 ile 11.25 arasında değer verdiğim zaman, bu aralıkta 20 değer çıkartacak.

Yardımlarınız için şimdiden teşekkür ederim.

 

[leumruk]

Merhaba,
Farklı bir konu olduğu için hazırladığım kodu ve örneği bu başlığa ekliyorum. Eğer konuyla ilgili sorularınız olacaksa farklı bir başlık açınız.

Sub Rastgele_Ondalikli()
If IsNumeric([d2]) = False Or IsNumeric([e2]) = False Or IsNumeric([f2]) = False Then
MsgBox "Veri girişini kontrol ediniz.", vbCritical, "UYARI"
Exit Sub
End If
ilkdeg = [d2]: sondeg = [e2]: Adet = [f2]
deg = sondeg - ilkdeg
If ilkdeg > sondeg Then deg = ilkdeg - sondeg
If deg * 100 + 1 < Adet Then
MsgBox "Belirttiğiniz aralıkta üretilebilecek sayı miktarı yazdığınız adetten az." _
& " İstediğiniz sayı adedini düşürünüz veya sayı aralığını azaltınız", vbCritical, "UYARI"
Exit Sub
End If
Columns(1).ClearContents
Do
Say = Say + 1
Tekrar:
sayi = Round(Rnd() * deg, 2) + ilkdeg
If WorksheetFunction.CountIf(Range("a1:a" & Adet), sayi) > 0 Then GoTo Tekrar
Cells(Say, "a") = sayi
Loop While Adet <> Say
MsgBox "İşlem tamam", vbInformation, "leumruk"
End Sub

 

[msanli]

Bu konuyla ilgili başka sorum yok sanırım. Uyarılarınıza dikkat ederim. Teşekkürler