kura ile görevlendirme

[karadeniz28]

başkan ve yardımcılarının görev yerlerini kura ile belirlemek istiyorum. yardımcı olursanız sevinirim

 

[Muhammet Okumuş]

hocam aynı anda seçiyor.

 

[Necdet]

Merhaba,

Hem alternatif olsun hemde müdür yardımcısız, yardımcı müdürsüz kalmasın diye bir mantık kurdum.

Sub Yerlestir()
Dim Bayrak      As Boolean
Dim i           As Integer
Dim Sat         As Integer
Dim GorevAdet   As Integer
GorevAdet = [D65536].End(3).Row - 1
Application.ScreenUpdating = False
Range("E2:F" & GorevAdet + 1).ClearContents
Range("A2:B" & [A65536].End(3).Row).Interior.ColorIndex = xlNone
For i = 2 To [A65536].End(3).Row
    Bayrak = True
    Do
        Randomize
        Sat = Int((GorevAdet * Rnd) + 1)
        If Cells(Sat + 1, "E") = "" Then
            Cells(Sat + 1, "E") = Cells(i, "A")
            Cells(i, "A").Interior.ColorIndex = 14
            Bayrak = False
        End If
    Loop While Bayrak = True
 
    Bayrak = True
    Do
        Randomize
        Sat = Int((GorevAdet * Rnd) + 1)
        If Cells(Sat + 1, "E") <> "" And Cells(Sat + 1, "F") = "" Then
            Cells(Sat + 1, "F") = Cells(i, "B")
            Cells(i, "B").Interior.ColorIndex = 40
            Bayrak = False
        End If
    Loop While Bayrak = True
Next i
Application.ScreenUpdating = True
End Sub

 

[leumruk]

Merhaba,
Bir alternatif de benden olsun.

Sub HücreSeç()
Dim hcr As Variant, hfz As Variant
Dim Aralik As Range, hdf As Range
Dim x As Long, sayi As Long
Set Aralik = Range("b3:b" & [g65536].End(3).Row)
Set hdf = Range("h3:h" & [g65536].End(3).Row)
For i = 1 To 2
hcr = Aralik
Randomize
For x = 1 To UBound(hcr, 1)
    sayi = Int(Rnd() * UBound(hcr) + 1)
    hfz = hcr(x, 1)
    hcr(x, 1) = hcr(sayi, 1)
    hcr(sayi, 1) = hfz
Next x
hdf = hcr
Set Aralik = Range("d3:d" & [g65536].End(3).Row)
Set hdf = Range("I3:I" & [g65536].End(3).Row)
Next
MsgBox "Kura çekimi tamamlanmıştır.", vbInformation, "leumruk"
End Sub

 

[İsmail Küçükşengün]

Paylaşımlara çok teşekkürler.

 

[karadeniz28]

teşekkür ederim arkadaşlar

 

[aahamdi2]

anlamı

Necdet bey. Yaptığınız kodları adım adım anlatabilir misiniz?

 

[Necdet]

Necdet bey. Yaptığınız kodları adım adım anlatabilir misiniz?

Aradan 2 yıl geçmiş, ben dün yaptığımı unutuyorum, şimdi nasıl anlatayım?

 

[aahamdi2]

anlamı

Kodlara bir bakmanız yeter Necdet Bey. Ben yaptığınızı hatırlayıp bana yardımcı olacağınızı ümit ediyorum.