Hafta sonun belirleme ???

[baba]

Bu Çalışma Sayfasında Aylar Günlere göre belirledim. Yanlız Hafta Sonuna Gelen Günlerin Renkli Halde Olmasının Sağlayamadım. Birde Kişilerin Haftada Bir gün olmak üzere Sıralanması ve Hafta sonuna Denk Gelmemesi için ne gibi bir formül Uygulayabiliriz. Konu Hakkında Yardımcı Olacak Arkadaşlar Şimdide Teşekkürü Bir Borç Bilirim. Saygılarımla

 

[Necdet]

Merhaba,

İsteğiniz Koşullu Biçimlendirme ile yapılabilir.

• A8:F8 Hücresini Seçiniz
• Koşullu Biçimlendirme
• Yeni Kural
• Biçimlendirilecek hücreleri belirlemek için Formül kullan
• Formül girişi yapılacak kısma

=HAFTANINGÜNÜ(D8;2)>5

ve TAMAM deyin


Not : Kişilerin sıralanmasını yapmadım. Çünkü bu kadar kişi olacağını sanmıyorum, ayrıca kişilerin listesi olması gerek.

 

[baba]

Tşkler ederim ellerinize sağlık sağollun yanlız bu sayı 5 ile 7 arasında değişebilir. ama şuanda 6 kişi olarak net bellidir.Bu konu hakkında da yardımcı olursanız sevinirim.

 

[Necdet]

Tşkler ederim ellerinize sağlık sağollun yanlız bu sayı 5 ile 7 arasında değişebilir. ama şuanda 6 kişi olarak net bellidir.Bu konu hakkında da yardımcı olursanız sevinirim.

Sanırım sayfa üzerindeki isimleri karışık olarak tüm günlere (cumartesi ve pazar günü hariç) dağıtmak istiyorsunuz.

Doğru anladıysam boş bir zamanımda ve eğer hiç kimse ilgilenmediyse ilgileneceğim.

 

[baba]

ewet doğrudur.

 

[Necdet]

Merhaba,

Kodları deneyiniz.

Sub Dagit()
    On Error Resume Next
    
    Dim i   As Integer, _
        j   As Integer, _
        Adt As Integer, _
        Kol As Integer, _
        Dz
    
    Application.ScreenUpdating = False
    
    Adt = Application.WorksheetFunction.CountA(Range("B8:B38"))
    If Adt = 0 Then Exit Sub
    
    ReDim Dz(1 To Adt, 1 To 2)
    
    For i = 8 To 38
        If Not Cells(i, "B") = "" Then
            j = j + 1
            Dz(j, 1) = Cells(i, "B")
            Dz(j, 2) = Cells(i, "C")
        End If
    Next i
    Kol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    
    Cells(1, Kol).Resize(j, 2) = Dz
    
    Randomize (Timer)
    For i = 1 To Adt
        Cells(i, Kol + 2) = Int((Adt * Rnd) + 1)
    Next i
    
    Range(Cells(1, Kol), Cells(Adt, Kol + 2)).Sort Key1:=Cells(1, Kol + 2)
    Range("B8:B38").ClearContents
    
    i = 7
    j = 0
    
    Do Until i > 38
        i = i + 1
        If Weekday(Cells(i, "D"), vbMonday) < 6 Then
            j = j + 1
            If j > Adt Then j = 1
            Cells(i, "B") = Cells(j, Kol)
            Cells(i, "C") = Cells(j, Kol + 1)
        End If
    Loop
    Range(Cells(1, Kol), Cells(Adt, Kol + 2)).ClearContents
    
    Application.ScreenUpdating = True
    
    MsgBox "Dağıtım tamamlanmıştır", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub

 

[baba]

çok tskler ederim ellerinize sağlık sağollun.