rasgele sayı üretme..

[ziabbs]

Merhabalar öncelikle.
userform'da commandbutton'a tıkladıkça 3 sayfanın a3,a8 hücreleri arasında birbirinden farklı olmak üzere (sıralı olsa daha iyi olur ama o kadar da önemli değil) sayılar üreten program parçacıgı nasıl yazılır?
ekteki dosyada aynı farklı hücrelerde aynı sayılar üretebiliyor.nasıl düzeltilebilir?
birde commandbutton'a 6 kez tıklandıktan sonra userform'un kendiliginden kapanmasını saglayabilir miyim? şöyleki 6 kez tıklamadan sonra üretilen sayıyı görmek için 3.sayfaya geçmek istiyorum.fakat userform açıkken bunu gerçekleştiremiyorum.son tıklamadan sonra direk 3.sayfaya geçiş olmayacak.onu ayrı bir şekilde gerçekleştirecegim.


3 textbox var.ve commandbutton'a tıkladıkça rasgele üretilecek sayıları hepsine birer tane gelecek şekilde yazdırabilir miyiz?

ilginiz ve alakanız için teşekkürler..

 

[leumruk]

Sayı aralığını belirtmemişsiniz. Sayı sınırlaması yok mu? Diğer bir husus: Her sütunda farklı sayılar olacak demişsiniz. Dizilişleri mi farklı olacak; yoksa her bir sayı birbirinden farklı mı olacak?

 

[ziabbs]

sayı aralıgı farketmez,ekteki dosyada 1-10 aralıgında oldugunu belirtmişim ama.sayılar birbirindne farklı olacak.

 

[hsayar]

sayı aralıgı farketmez,ekteki dosyada 1-10 aralıgında oldugunu belirtmişim ama.sayılar birbirindne farklı olacak.

yeni bir modul ekleyiniz ve aşağıdaki kodları yapıştırınız.

Public Enum enCevap
  enCevapEvet
  enCevapHayır
End Enum

Function BenzersizRastgeleSayilar(KacAdetSayi As Long, EnKucukSayi As Long, EnBuyukSayi As Long, Optional Sıralımı As enCevap) As Variant
'Benzersiz Rastgele Sayılar Üretir.
'Kullanımı Aşağıdaki gibidir
'Data = UniqueRandomNumbers(6, 1, 49)
Dim RandColl As Collection, varTemp() As Long
Dim k&, i&, j&
BenzersizRastgeleSayilar = False

If KacAdetSayi < 1 Then Exit Function
If EnKucukSayi > EnBuyukSayi Then Exit Function
If KacAdetSayi > (EnBuyukSayi - EnKucukSayi + 1) Then Exit Function
Set RandColl = New Collection
Randomize
Do
On Error Resume Next
i = CLng(Rnd * (EnBuyukSayi - EnKucukSayi) + EnKucukSayi)
RandColl.Add i, CStr(i)
On Error GoTo 0
Loop Until RandColl.Count = KacAdetSayi

ReDim varTemp(1 To KacAdetSayi)

For i = 1 To KacAdetSayi
varTemp(i) = RandColl(i)
Next i
Set RandColl = Nothing

If Sıralımı = enCevapEvet Then
  '**************ripek********************
  For i = 1 To KacAdetSayi - 1
      For j = i + 1 To KacAdetSayi
          If varTemp(i) > varTemp(j) Then
              k = varTemp(i)
              varTemp(i) = varTemp(j)
              varTemp(j) = k
          End If
      Next j
  Next i
  '**************ripek********************
End If
BenzersizRastgeleSayilar = varTemp
Erase varTemp
k = 0: i = 0: j = 0
'*****www.excel.web.Tr***********
End Function

userform üzerindeki kodları aşağıdaler ile değiştiriniz.

Private Sub UserForm_Initialize()
CommandButton1.Tag = 0
End Sub
Private Sub CommandButton1_Click()
If CommandButton1.Tag > 6 Then
  MsgBox "işlem limitiniz dolmuştur."
  Exit Sub
End If
Dim wsSNC    As Excel.Worksheet
Dim arrBRS As Variant
'1 en küçük sayı- 100 en büyük sayıdır. ihtiyaca göre düzenleyiniz.
arrBRS = BenzersizRastgeleSayilar(6, 1, 100, enCevapEvet)


Set wsSNC = Worksheets("Sayfa3")
With wsSNC
  .Range("A3") = arrBRS(1)
  .Range("A4") = arrBRS(2)
  .Range("A5") = arrBRS(3)
  .Range("A6") = arrBRS(4)
  .Range("A7") = arrBRS(5)
  .Range("A8") = arrBRS(6)
End With
CommandButton1.Tag = CommandButton1.Tag + 1
End Sub

 

[hsayar]

Ben hepsini bir kerede bulduğım için altı tıklamaya gerek yok galiba o zaman uf deki kodları aşağıdaki gibi düzeltelim.

Private Sub CommandButton1_Click()
Dim wsSNC    As Excel.Worksheet
Dim arrBRS As Variant
'1 en küçük sayı- 100 en büyük sayıdır. ihtiyaca göre düzenleyiniz.
arrBRS = BenzersizRastgeleSayilar(6, 1, 100, enCevapEvet)


Set wsSNC = Worksheets("Sayfa3")
With wsSNC
  .Range("A3") = arrBRS(1)
  .Range("A4") = arrBRS(2)
  .Range("A5") = arrBRS(3)
  .Range("A6") = arrBRS(4)
  .Range("A7") = arrBRS(5)
  .Range("A8") = arrBRS(6)
End With
unload me
End Sub

yada sayfaya bile gitmeden uf üzerine bir label ekleyerek çözebilirsiniz.

Private Sub CommandButton1_Click()
Dim arrBRS As Variant
arrBRS = BenzersizRastgeleSayilar(6, 1, 100, enCevapEvet)
Label1.Caption = arrBRS(1) & Space(5) & arrBRS(2) & Space(5) & arrBRS(3) & Space(5) & _
                 arrBRS(4) & Space(5) & arrBRS(5) & Space(5) & arrBRS(6) & Space(5)
End Sub

 

[leumruk]

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
If [Sayfa3!a10] <> "" Then
MsgBox "İşleminiz tamamlanmıştır."
Sheets("Sayfa1").Select
Exit Sub
End If
If [a10] <> "" And [Sayfa2!a10] = "" Then Sheets("Sayfa2").Select
If [a10] <> "" And [Sayfa2!a10] <> "" Then Sheets("Sayfa3").Select
Randomize
    While i <= 9 - 1
        sayi = Int(100 * Rnd + 1)
        If WorksheetFunction.CountIf([a3:a10], sayi) = 0 Then
            i = Cells(9 + 1, 1).End(3).Row + 1
            Cells(i, 1) = sayi
            Sheets("Sayfa1").Select
            Unload Me
            Exit Sub
        End If
    Wend
End Sub

Alternatif olarak düşünülebilir.

 

[ziabbs]

teşekkürler arkadaşlar.