sayı üretmek

[Muhammet Okumuş]

100'e kadar rastgele sayı üretmek istiyorum.
kural butona her bastığımda a1'den başlayarak b1,c1.d1 ...yatay olarak t1'e kadar sayı üreteceğim.t1'den sonra a2ye geçecek ve yine t2'ye geldiğinde c1'e geçecek.
bu şekilde kod nasıl yazılabilirç

 

[dEdE]

Merhaba,
Aşağıdaki linki izleyiniz.

http://www.excel.web.tr/f142/rastgele-say-uretme-t58558.html

 

[Muhammet Okumuş]

aradığım şartı orda bulamadım

 

[dEdE]

kural butona her bastığımda a1'den başlayarak b1,c1.d1 ...yatay olarak t1'e kadar sayı üreteceğim.t1'den sonra a2ye geçecek ve yine t2'ye geldiğinde c1'e geçecek.

t2'ye geldiğinde c1'e geçecekse ilk yazdıkları silinir. Ben mi yanlış anladım, yoksa siz yanlış mı yazdınız?

 

[Muhammet Okumuş]

silinmeyecek butona bastığımda sırayla sayı üretecek

 

[leumruk]

Selamlar,
Ekli örneği inceleyiniz.

 

[Muhammet Okumuş]

sn leumruk çok teşekkür ederim.emeğinize sağlık

 

[leumruk]

sn leumruk çok teşekkür ederim.emeğinize sağlık

Rica ederim. İyi çalışmalar.

 

[Muhammet Okumuş]

sn leumruk kod bölümünde t yazmızşınız orayı u yaptım ama yine t sütununa kadar sayı üretti.acaba bunu nasıl genişletebiliriz yada daraltabiliriz

 

[leumruk]

Kırmızı bölgelerde değişiklik yapacaksınız. Ayrıca 100 adet sayı ürettiği için hücre sayısı 100 olmalı, fazlasını üretmez. Sayıyı artırmak istiyorsanız, kod içindeki 100 rakamını artırabilirsiniz.

Sub Kura()
Sat = 1
If [[COLOR="Red"]t1[/COLOR]] <> "" Then Sat = 2
If [[COLOR="red"]t2[/COLOR]] <> "" Then Sat = 3
If [[COLOR="red"]t3[/COLOR]] <> "" Then Sat = 4
If [[COLOR="red"]t4[/COLOR]] <> "" Then Sat = 5
If [[COLOR="red"]t5[/COLOR]] <> "" Then
MsgBox "Kura çekimi tamamlanmıştır."
Exit Sub
End If
    Sut = Cells(Sat, 256).End(1).Column
BASLA:
    sayi = Int((100 * Rnd) + 1)
    If WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(5, "[COLOR="red"]t[/COLOR]")), sayi) > 0 Then GoTo BASLA
    If Cells(Sat, 1) = "" Then
    Cells(Sat, Sut) = sayi
    Else
    Cells(Sat, Sut + 1) = sayi
    End If
End Sub

 

[Muhammet Okumuş]

çok teşekkür ederim sn leumruk

 

[leumruk]

çok teşekkür ederim sn leumruk

Rica ederim. İyi çalışmalar.

 

[Muhammet Okumuş]

sn leumruk peki butonu sayfa2'ye kopyalamak istiyorum.ama sayıları yine sayfa birden seçecek.bunu yapabilirmiyiz

 

[leumruk]

Kırmızı satırları ekleyin

Sub Kura()
[COLOR="Red"]Application.ScreenUpdating = False
Sheets("Sayfa1").Select[/COLOR]
Sat = 1
If [t1] <> "" Then Sat = 2
If [t2] <> "" Then Sat = 3
If [t3] <> "" Then Sat = 4
If [t4] <> "" Then Sat = 5
If [t5] <> "" Then
MsgBox "Kura çekimi tamamlanmıştır."
Exit Sub
End If
    Sut = Cells(Sat, 256).End(1).Column
BASLA:
    sayi = Int((100 * Rnd) + 1)
    If WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(5, "t")), sayi) > 0 Then GoTo BASLA
    If Cells(Sat, 1) = "" Then
    Cells(Sat, Sut) = sayi
    Else
    Cells(Sat, Sut + 1) = sayi
    End If
[COLOR="red"]Sheets("Sayfa2").Select
Application.ScreenUpdating = True[/COLOR]
End Sub

 

[Muhammet Okumuş]

sn leumruk oldu ama bu kez 100 e kadar basabiliyorum.ben makroları 10 satıra kadar uzattım ama 100 sayıyı farklı seçiyor.aynı sayıları tekrar seçebilir.

 

[leumruk]

If WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(5, "t")), sayi) > 0 Then GoTo BASLA

Bu satırı kodlarınızdan silerseniz, aynı sayılar da denk gelebilir.

 

[Muhammet Okumuş]

Kırmızı bölgelerde değişiklik yapacaksınız. Ayrıca 100 adet sayı ürettiği için hücre sayısı 100 olmalı, fazlasını üretmez. Sayıyı artırmak istiyorsanız, kod içindeki 100 rakamını artırabilirsiniz.

Sub Kura()
Sat = 1
If [[COLOR="Red"]t1[/COLOR]] <> "" Then Sat = 2
If [[COLOR="red"]t2[/COLOR]] <> "" Then Sat = 3
If [[COLOR="red"]t3[/COLOR]] <> "" Then Sat = 4
If [[COLOR="red"]t4[/COLOR]] <> "" Then Sat = 5
If [[COLOR="red"]t5[/COLOR]] <> "" Then
MsgBox "Kura çekimi tamamlanmıştır."
Exit Sub
End If
    Sut = Cells(Sat, 256).End(1).Column
BASLA:
    sayi = Int((100 * Rnd) + 1)
    If WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(5, "[COLOR="red"]t[/COLOR]")), sayi) > 0 Then GoTo BASLA
    If Cells(Sat, 1) = "" Then
    Cells(Sat, Sut) = sayi
    Else
    Cells(Sat, Sut + 1) = sayi
    End If
End Sub

arkadaşlar istedğim 3 şey var
1. Bu kod sadece 100'e kadar tekrarsız sayı üretiyor.100'e kadar aynı sayılar üretilebilir.
2. Sadece aynı sütunlarda tekrarsız 100 e kadar sayı üretsin.
3. Butona birkez bastığımda aynı anda sütünlarda tekrarsız sayı üretmek.

 

[Muhammet Okumuş]

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

bu kod a1 ve b1 hücrelerinde aynı anda sayı üretiyor.bir kez batığımda a1 sonra b1 de nasıl üretebilirim

 

[Muhammet Okumuş]

arkadaşlar ben hala yapamadım

 

[leumruk]

Selamalar,
Aşağıdaki kodu deneyin. G1 hücresine değişken atadım. Bunu isterseniz değiştirebilirsiniz.

Sub uret()
Randomize
For i = 1 To 100
If Cells(i, 1) = "" And [g1] = "" Then
Cells(i, 1) = Int((Rnd * 100) + 1)
[g1] = 1
Exit Sub
End If
If Cells(i, 2) = "" And [g1] = 1 Then
Cells(i, 2) = Int((Rnd * 100) + 1)
[g1] = ""
Exit Sub
End If
Next i
End Sub