Kura çekimi

[argo619]

Değerli üstadlarım işyerinde her yıl personellerin izinlerini kura ile belirliyoruz
ekli dosyamda yaptığım kura çekme putonuna her tıklamada bir ay ismi çıkıyor
yalnız sorunum şu işçiye tıkla deyince izin tarihini belirlebutonunu tıkla deyince bazan iki kez üst üste tıklıyorlar
böyle olunca de ikinci kez yapılan tıklamada başka bir kura çekmiş oluyor
ikinci kez tıklamasını nasıl önleyebiliriz
yada üst üste yapılan ikinci tıklamada bizi nasıl uyarabilir
saygılarımla

 

[leumruk]

Merhaba,
Örneği deneyiniz. Her açılışta bir kura çakim hakkı var. Tekrar kura çekebilmek için userformu kapatıp açmalısınız.

 

[argo619]

Üstadım harikasınız allah razı olsun
çok teşekkürler

 

[leumruk]

Üstadım harikasınız allah razı olsun
çok teşekkürler

Rica ederim.

 

[peleryn]

Kura demişken yeni yıl kurası için bir çalışma yapılabilir mi diye düşündüm.B sütununda 20 isim var C sütununa bu isimler B sütunundaki isimlerin karşısına dağılacak (birbirine hediye alacak personeli belirlemek için) ama dikkat edilmesi gereken iki husus var:bir kişiye kendi ismi çıkmayacak ve aynı isim birden fazla kişiye çıkmayacak..

 

[leumruk]

Syn. peleryn,
Ekteki dosyayı inceleyin:

Private Sub CommandButton1_Click()
Tekrar:
Dim q As Variant, r As Variant
Dim random As Range
Dim x As Long, y As Long
Range("C1:C" & [C65536].End(3).Row).ClearContents
Range("B1:B" & [b65536].End(3).Row).Copy
[C1].PasteSpecial Paste:=xlValues: Application.CutCopyMode = False
Set random = Range("C1:C" & [C65536].End(3).Row)
q = random.Value
Randomize
For x = 1 To UBound(q, 1)
    y = Int(Rnd() * UBound(q) + 1)
    r = q(x, 1)
    q(x, 1) = q(y, 1)
    q(y, 1) = r
Next x
random.Value = q
For z = 1 To [b65536].End(3).Row
If Cells(z, "b") = Cells(z, "c") Then GoTo Tekrar
Next
End Sub

 

[peleryn]

Hocam ellerinize sağlık çok güzel çalışıyor.İlgilendiğiniz için çok teşekkür ederim.

 

[leumruk]

Hocam ellerinize sağlık çok güzel çalışıyor.İlgilendiğiniz için çok teşekkür ederim.

Rica ederim.

 

[zeysim]

Slm benim 30 kişilik bir sınıfm var öğrenci listemi yeniden yeniden girmek zorunad kalmadan excelde bir kere listemi girdiğimde butona bastığımda 30 kişiden 1 kişiyi seçecek şekide bir kura programı hazırlanması mümkünmü gerçi üstteki örnek işimi görebilir en üstekini seçilmiş varsayabilir ama o örenği 3o kişiye çıkarmak mümkünmü. bana eşleştirme değil 30kişiden birisini seçmesi butona her bastığımda başka birini seçecek şekilde düzenlemek mükün mü şimdiden teşekkürler.

 

[leumruk]

Merhaba,
Aşağıdaki örneği deneyiniz. Öğrenci sayısını isteğinize göre çoğaltabilirsiniz.

Sub Secim_Yap()
q = [a65536].End(3).Row
If WorksheetFunction.CountA(Range("b1:b" & q)) >= q Then
Sor = MsgBox("Tüm öğrencilerin kura çekimi tamamlandı. Seçim sıfırlansın mı?", vbYesNo)
If Sor = vbYes Then Range("b1:b" & q).ClearContents: [c1] = "": Exit Sub
If Sor = vbNo Then Exit Sub
End If
Tekrar:
sayi = Int((q * Rnd) + 1)
If Cells(sayi, "b") = "*" Then GoTo Tekrar
[c1] = Cells(sayi, "a")
Cells(sayi, "b") = "*"
End Sub

 

[zeysim]

Çok teşekkürler çok işime yarayacak

 

[leumruk]

Çok teşekkürler çok işime yarayacak

Rica ederim. İyi çalışmalar...

 

[ersegun07]

arkadaşlar saygılar ben senelik izin eşleştirmesinin aynı anda yapılmasını istiyorum yani iki ayrı veri girilecek ve listenin tamamını eşleştirecek bu mümkün mü?

 

[özder1]

Çok teşekkürler, işimi fazlasıyla gördü.

 

[extremetonic]

Syn. peleryn,
Ekteki dosyayı inceleyin:

Private Sub CommandButton1_Click()
Tekrar:
Dim q As Variant, r As Variant
Dim random As Range
Dim x As Long, y As Long
Range("C1:C" & [C65536].End(3).Row).ClearContents
Range("B1:B" & [b65536].End(3).Row).Copy
[C1].PasteSpecial Paste:=xlValues: Application.CutCopyMode = False
Set random = Range("C1:C" & [C65536].End(3).Row)
q = random.Value
Randomize
For x = 1 To UBound(q, 1)
    y = Int(Rnd() * UBound(q) + 1)
    r = q(x, 1)
    q(x, 1) = q(y, 1)
    q(y, 1) = r
Next x
random.Value = q
For z = 1 To [b65536].End(3).Row
If Cells(z, "b") = Cells(z, "c") Then GoTo Tekrar
Next
End Sub

Çok teşekkürler. Ama bir sorum var. Butonu değiştirme olanağımız yok mu? Butonda değişiklik yapamıyorum?