Rastgele bilet numarası verip kaydetmek

[maskont]

Selamlar;

Bir çekiliş için 1000 ile 9999 arası rastgele bilet numarası çıkartmak ve onları diğer sayfaya kaydetek istiyorum. Şöyle ki:
İlk sayfada kişi ismi ve istediği bilet sayısını elle girilecek hücreler, ''Bilet Ver'' ve ''Kaydet'' butonları olacak. İsim ve istenilen bilet sayısı girilip ''Bilet Ver'' butonuna tıklanınca aynı sayfada istenilen bilet sayısı kadar 1000 ile 9999 aralığında rastgele numara verilecek. ''Kaydet'' butonuna tıklanınca verilen bilet numaraları ve kişi ismi ikinci sayfaya kaydedilecek. Ayrıca başka bir kişi için bilet numarası verilirken, daha önceden kaydedilmiş olan bilet numaralarından verilmemesi gerekiyor.

Forumda arama yaptım ancak istediğimi bulamadım. Şimdiden ilginize teşekkür ederim. Saygılar.

 

[Necdet]

Merhaba,

Sizin mantığınıza uyar mı bilemiyorum, ben yoğurdu böyle yedim.

Dosyayı inceleyiniz.

Private Sub CommandButton1_Click()
    On Error Resume Next
 
    Dim i       As Integer, _
        j       As Integer, _
        Adet    As Integer, _
        s1      As Worksheet, _
        s2      As Worksheet, _
        Sira    As Variant, _
        BiletNo As Integer, _
        Biletler() As Variant
 
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
 
    Adet = CInt(TextBox2.Value)
    If Adet = 0 Then
        MsgBox "Bilet Sayısını Doğru Giriniz"
        Exit Sub
    End If
 
    j = -1
    '--- Eski çekilen biletleri Diziye Al
    For i = 2 To s2.Cells(Rows.Count, "A").End(3).Row
        j = j + 1
        ReDim Preserve Biletler(0 To j)
        Biletler(j) = s2.Cells(i, "B")
    Next i
 
    If j = -1 Then ReDim Biletler(0 To 0)
 
    With ListView1
 
        .ListItems.Clear
 
        For i = 1 To Adet
            Sira = 0
            Do
                Randomize
                BiletNo = Int((9999 * Rnd) + 1)
                [COLOR=red]If BiletNo >= 1000 Then _[/COLOR]
                        Sira = Application.VLookup(BiletNo, Application.Transpose(Biletler), 1, 0)
            Loop Until IsError(Sira)
 
            With .ListItems.Add
                .Text = Format(BiletNo, "0000")
                j = UBound(Biletler) + 1
                ReDim Preserve Biletler(0 To j)
                Biletler(j) = BiletNo
            End With
 
        Next i
 
    End With
End Sub

Private Sub CommandButton2_Click()
    Dim i   As Integer, _
        Sat As Integer, _
        s1  As Worksheet, _
        s2  As Worksheet
 
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
 
    Sat = s1.Cells(Rows.Count, "A").End(3).Row + 1
 
    '--- Sayfa1 e Yazmak
    s1.Cells(Sat, "A") = TextBox1.Value
    s1.Cells(Sat, "B") = TextBox2.Value
 
    '--- Sayfa2'ye yazdırmak
    Sat = s2.Cells(Rows.Count, "A").End(3).Row
 
    For i = 1 To ListView1.ListItems.Count
        Sat = Sat + 1
        s2.Cells(Sat, "A") = TextBox1.Value
        s2.Cells(Sat, "B") = ListView1.ListItems(i).Text
    Next i
 
    TextBox1.Value = ""
    TextBox2.Value = ""
    ListView1.ListItems.Clear
 
End Sub

Private Sub CommandButton3_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    With ListView1
        .View = lvwReport
        .Gridlines = True
        .FullRowSelect = True
        .LabelEdit = lvwManual
        .ColumnHeaders.Add , , "Bilet No", 60
    End With
End Sub

 

[maskont]

Hocam ellerinize sağlık, tam istediğim gibi hatta daha güzeli olmuş.İlk sayfada istenilen bilet sayisinin çıkması harika. Sonsuz teşekkür ederim size .
Ben ek olarak verilen bilet sayısının 1000-9999 arasında olması için ''BiletNo = Int((8999 * Rnd) + 1000)'' olarak değiştirdim, sanırım doğrudur.
Ancak bazen farklı kişilere aynı bilet numarası verebiliyor, zisce bunu nasıl düzeltebilirim ?

 

[Necdet]

Hocam ellerinize sağlık, tam istediğim gibi hatta daha güzeli olmuş.İlk sayfada istenilen bilet sayisinin çıkması harika. Sonsuz teşekkür ederim size .
Ben ek olarak verilen bilet sayısının 1000-9999 arasında olması için ''BiletNo = Int((8999 * Rnd) + 1000)'' olarak değiştirdim, sanırım doğrudur.
Ancak bazen farklı kişilere aynı bilet numarası verebiliyor, zisce bunu nasıl düzeltebilirim ?

Pardon pardon 2 kontrolden birini unutmuşum. Zaman bulursam düzelteceğim.

 

[uzmanamele]

merhaba

Necdet beyin zamanı yok sanırım, ben küçük bir ekleme yaptım, deneyiniz.

...
...
Do
10:
Randomize
BiletNo = Int((9999 * Rnd) + 1)
If BiletNo < 1000 Then GoTo 10
...
...

 

[Necdet]

Merhaba,

2 Numaralı mesajımdaki dosyayı yeniledim, inceler misiniz?

 

[maskont]

Sayın Necdet Yeşertener bilginize emeğinize sağlık. Tam istediğim gibi olmuş . Çok teşekür ederim.

Sayın ''uzmanamele'' ilginize teşekkür ederim. Ben onu ''BiletNo = Int((8999 * Rnd) + 1000)'' olarak yazdığımda da aynı sonucu verdi, bilmiyorum ne kadar doğrudur

 

[Necdet]

Sayın Necdet Yeşertener bilginize emeğinize sağlık. Tam istediğim gibi olmuş . Çok teşekür ederim.

Sayın ''uzmanamele'' ilginize teşekkür ederim. Ben onu ''BiletNo = Int((8999 * Rnd) + 1000)'' olarak yazdığımda da aynı sonucu verdi, bilmiyorum ne kadar doğrudur

Güle güle kullanınız.
Mesajımda 1000 den aşağı numaraları eledim.