farklı sayı bulma

[karahan61]

Merhaba Arkadaşlar

Yıl Sonu etkinliklerde farklılık olsun diye yapacağımız çekilişte olmasını istedıklarım ekli dosyada gösterilmiştir. Mevcut kod'u yazan arkadaşın emeğine sağlık ancak istenilen değişikli yapacak arkadaşlara sonsuz teşekkür ederim.

 

[karahan61]

Merhaba Arkadaşlar

Yıl Sonu etkinliklerde farklılık olsun diye yapacağımız çekilişte olmasını istedıklarım ekli dosyada gösterilmiştir. Mevcut kod'u yazan arkadaşın emeğine sağlık ancak istenilen değişikli yapacak arkadaşlara sonsuz teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu boş bir modüle ekleyip denermisiniz.

Çekiliş sayısından kastınızı tam olarak anlayamadığım için o bölüme kod yazmadım. (Bununla ilgili koduda ekledim.)

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Sub ÇEKİLİŞ()
    Dim SAYI As Integer, SATIR As Integer, SAY As Byte, ZAMAN As Integer
 
    If Range("F6") = "" Then
        MsgBox "Lütfen çekiliş sayısı giriniz !", vbExclamation
        Range("F6").Select
        Exit Sub
    End If
 
    If Range("F6") = WorksheetFunction.CountA(Range("A5:A65536")) Then
        MsgBox "Çekiliş sayınız dolmuştur !" & Chr(10) & _
        "Sayfadaki eski bilgileri temizleyip daha sonra tekrar deneyiniz.", vbCritical
        Exit Sub
    End If
 
    ZAMAN = Range("H6")
 
BAŞLA:
    Randomize
    SAYI = Int(Rnd() * 2501)
    If WorksheetFunction.CountIf(Range("B:B"), SAYI) > 0 Then GoTo BAŞLA
 
    If Range("A5") = "" Then
        SATIR = 5
    Else
        SATIR = Range("A65536").End(3).Row + 1
    End If
 
    Range("D5") = SAYI
 
    Do While SAY < ZAMAN
        DoEvents
        Sleep (500)
        Range("D5") = ""
        Sleep (500)
        Range("D5") = SAYI
        SAY = SAY + 1
    Loop
 
    Cells(SATIR, "A") = SATIR - 4
    Cells(SATIR, "B") = SAYI
End Sub
 
Sub VERİLERİ_TEMİZLE()
    Range("A5:B65536").ClearContents
End Sub

 

[karahan61]

hocam merhaba çekiliş sayısı ikramiye adedi kadar (mesela 15) önerdiğiniz kodu denedim başaramadım size zahmet siz deneyip ekler misiniz. Çok makbule geçecek

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. Ayrıca örnek dosyada ekledim. İncelermisiniz.

 

[karahan61]

sonsuz teşekkürler