rastgele sayı üretimi

[Muhammet Okumuş]

arkadaşlar rastgele sayı üretmek istiyorum.
kural düğmeye bastığımda a1 ve b1 sütununda 100e kadar sayı üretmek istiyorum.
düğmeye ikici kez bastığımda a2 b2. a3 b3 ....... a500 b500 şeklinde üretecek.
yardımlarınızı bekliyorum

 

[Kemal Demir]

Merhaba,

Sub uret()
say = [a65536].End(3).Row + 1
For x = 1 To 100
Cells(say, x) = Int(Rnd(x) * 100)
Next
End Sub

Yukarıdaki kod zannedersem işinizi görebilir.

 

[Muhammet Okumuş]

kardeş benim istediğim bu şekilde değil.
düğmeye ilk bastığımda a1 sonra 2.de b1 3.de a2 4.de b2 5.a3 6. bastığımda b3 hücresine sayı vermek istiyorum

 

[Muhammet Okumuş]

çekiliş

dosyayı inceleyebilirmisiniz

 

[Hüseyin]

dosyayı inceleyebilirmisiniz

Siz ne istediğinizi mesaja yazmaya üşeniyorsanız, biz neden vakit ayırıp inceleyelim?

 

[Muhammet Okumuş]

hocam zaten dosyanın içinde anlatıyorum ne istediğimi.zaten dosya olmadan anlatsam kimse anlamaz

 

[Hüseyin]

Uyarıları dikkate almayıp "Ben burnumun dikine giderim" diyorsunuz yani.

Bakın ne demek istediğimi anlatmaya çalışayım.

Size yardım edebilecek olan her arkadaşın çeşitli konularda daha fazla bilgisi var.
dolayısıyla her biri bilgi sahibi oldukları konuları öncelikle ele almaya çalışıyorlar.

Mesaj başlığınız "çekiliş" , bu hiçkimseye bilgi vermiyor.
Bir de mesaj içinde konunun neyle ilgili olduğu veya hangi araçlarla çözülebileceği yönünde hiçbir ipucu yok.
Şimdi bu arkadaşların hiç işi yok, sizin dosyanızı andirecek, açacak, okuyacak veya anlamaya çalışacak. Sonra kendisisnin yardımcı olacağı bir konu mu değil mi onu anlayacak.
Bunu neden yapsın.
Yardım almak istiyorsanız, size yardım etmek için vakit ayıracak insanlara en azından bir ön bilgi verin ki, onlarda size yardım etmek için teşvik olsunlar.

Bu şekilde mesaj gönderirseniz forumdan yardım alabileceğiniz sanmıyorum.

Diğer bir konuda lütfen forumu boş yere "Yardım edecek kimse yokmu" gibi mesajlarla meşgul etmeyin.

 

[Muhammet Okumuş]

tamam hüseyin hocam.bundan sonra dosyayla birlikte anlatmaya çalışırım.

 

[uzmanamele]

merhaba
syn muokumuş,
lütfen sorularınızın kısa özetini mesaj içersinde yazınız.
acaba ne sorulmuş diye dosyayı indir, sıkıştırılmış dosyayı aç, soruyu oku, yapabiliyorsan yap, konu hakkında bilgin yoksa dosyayı kapat, indirilen dosyayı sil.
bu işlemler ne kadar bir süre tutar sizce?
hepimiz çalışan insanlarız, normal mesai saatleri içersinde arkadaşlarımıza yardımcı olmaya çalışıyoruz. zaman konusunda bizlere yardımcı olmazsanız bizde sizlere yeterince zaman ayıramaz, yardımcı olamayız.

 

[Muhammet Okumuş]

arkadaşlar a sütununda uefa takımları b sütununda o takımın bağlı olduğu ülke var.h sütununa takımlar seçilecek ı sütunauna ülkeler gelecek. ı sütununa gelecek ülkelerin toplamı e sütununda belirtilen kontejandan fazla olamaz.fazla olduğu zaman koşula uyan başka takımın gelmesini istiyorum.

 

[Levent Menteşoğlu]

Aşağıdaki kdu deneyin. A sütunundaki takımlardan rasgele seçer ve ülke limitine göre H sütununda sıralar.

Sub listele()
say = [a65536].End(3).Row + 1
For a = 1 To 32
10 deg = Int(Rnd * say)
If deg < 2 Then GoTo 10
ulke = WorksheetFunction.CountIf([I:I], Cells(deg, "b"))
limit = Cells(WorksheetFunction.Match(Cells(deg, "b"), [D:D], 0), "e")
If ulke < limit And WorksheetFunction.CountIf([H:H], Cells(deg, "a")) = 0 Then
c = c + 1
Cells(c + 1, "h") = Cells(deg, "a")
Cells(c + 1, "I") = Cells(deg, "b")
Else
GoTo 10
End If
Next
[H2:I33].Sort Key1:=[I2], Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End Sub

 

[Muhammet Okumuş]

Levent Hocam çok teşekkür ederim.Peki bu tek tek mümkün mü.her butona bastığımda takım seçsin

 

[Ayhan Ercan]

Merhaba sn muokumus

Aşağıda vermiş olduğum linkte, 1.Mesajın (sayın Ali'nin mesajı) 4.maddesini okuyabilirmisiniz.?



Hatta tüm mesajıda okuyun...

http://www.excel.web.tr/showthread.php?t=25986

 

[Muhammet Okumuş]

tamam arkadaşlar özür dilerim.bilmiyordum

 

[Levent Menteşoğlu]

Levent Hocam çok teşekkür ederim.Peki bu tek tek mümkün mü.her butona bastığımda takım seçsin

Tek tek için aşağıdaki kodu deneyin.

Sub listele()
say = [a65536].End(3).Row + 1
10 deg = Int(Rnd * say)
If deg < 2 Then GoTo 10
ulke = WorksheetFunction.CountIf([I:I], Cells(deg, "b"))
limit = Cells(WorksheetFunction.Match(Cells(deg, "b"), [D:D], 0), "e")
If ulke < limit And WorksheetFunction.CountIf([H:H], Cells(deg, "a")) = 0 Then
sat = WorksheetFunction.CountA([h2:h33]) + 2
Cells(sat, "h") = Cells(deg, "a")
Cells(sat, "I") = Cells(deg, "b")
Else
GoTo 10
End If
[H2:I33].Sort Key1:=[I2], Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End Sub

Not: Bu arada yazdığınız açıklama sonucunda konu dikkatimi çektiği için sorunuzla ilgilendim. Değerli arkadaşlarımın yukarıda belirttiği uyarıların ne kadar haklı olduğunun bir göstergesidir. Bu konuya tüm üyelerimizin dikkatini çekmek istiyorum.

 

[janveljan]

Bu kodları veya ekteki dosyayı kullanabilirsiniz.

Sub uret()
    For i = 1 To 500
        If Cells(i, 1) = "" Then
        Cells(i, 1) = Int(Rnd() * 100)
        Exit Sub
        ElseIf Cells(i, 2) = "" Then
        Cells(i, 2) = Int(Rnd() * 100)
        Exit Sub
        End If
    Next
End Sub

Kusura bakmayın ilk mesajı okuyup araya dalmışım, cevabım en baştaki soru için.

 

[Muhammet Okumuş]

levent hocam güzel olmuş.ama bi sorum var.makro bilgim olmadığı için kod üzerinde düzenleme yapamıyorum.seçilen takımlar harf sırasına göre.onu iptal edebilir miyiz?hangi takımın çıktığı belli olmuyor

 

[leumruk]

[H2:I33].Sort Key1:=[I2], Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

Bu kısmı silersen sorun kalmaz.

Bu arada Levent Hocam, ellerine sağlık. Bugün benim için çok faydalı oldu.

 

[Muhammet Okumuş]

çok teşekkür ederim levent ve leumruk hocam

 

[Levent Menteşoğlu]

Rica ederim Sn muokumus ve Sn leumruk.