• DİKKAT

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

Rastgele Sayı Üretme!

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Selamlar,
Kod: 
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
 

Ekli dosyalar

Son düzenleme:
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?
 
mavi674' Alıntı:
ç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 ?
Genişletmek için tıkla ...
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.
Kod: 
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
 

Ekli dosyalar

muokumus' Alıntı:
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?
Genişletmek için tıkla ...
Aşağıdaki kodu deneyin.
Kod: 
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
 

Ekli dosyalar

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.
 
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' Alıntı:
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.
Genişletmek için tıkla ...

Tekrar hatırlatmam gerekiyor sanırım.
 
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.
 
muokumus' Alıntı:
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.
Genişletmek için tıkla ...

Bu konudaki kararı Sn Mustafa bey verecektir. Eğer kendisi arzu ederse konuyu makro-vba başlığına taşıyabiliriz.
 
Levent Menteşoğlu' Alıntı:
Bu konudaki kararı Sn Mustafa bey verecektir. Eğer kendisi arzu ederse konuyu makro-vba başlığına taşıyabiliriz.
Genişletmek için tıkla ...
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...
 
leumruk' Alıntı:
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...
Genişletmek için tıkla ...

Sn Mustafa bey

Öneriniz yerinde bir öneridir. Bencede böylesi daha uygun olacaktır.
 
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.
 

Ekli dosyalar

leumruk' Alıntı:
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.
Genişletmek için tıkla ...

Sayin leumruk,

Emeginize Tesekurler
 
Son düzenleme:
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.
 
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:?
 
leumruk' Alıntı:
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
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
Genişletmek için tıkla ...
 
muokumus' Alıntı:
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.
Genişletmek için tıkla ...

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
 
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.
 
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.
Kod: 
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
 

Ekli dosyalar

Bu konuyla ilgili başka sorum yok sanırım. Uyarılarınıza dikkat ederim. Teşekkürler
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst