YARDIM! Birçok kuralı birden denetleme

[albatros79]

Yeni çıkan kurallar geregi kullandığımız formun doldurulurken birçok kritere uyumluluğunun sağlanması lazım. Aklımda algoritma olarak nasıl yapılabileceğine dair bir fikir olsa da vba bilgim bunu hayata geçirmek için yetersiz :frown:

ekteki dosyada bir calısanın calıstıgı ve dinlendiği saatler gosterilmektedir.
macro ile ilgili hucreye 2 kez tıklandığında "X" işareti konulmakta bu da o çalışanın belirtilen saatte çalışmadığını göstermektedir.

Uluslararası kurallar gereği bizden istenen şartlar aşağıdadır :

1- bir kişi herhangi 24 saat içinde maksimum 14 saat çalışabilir (gün değil, herhangi 24 saat)
2-bir kişi herhangi 7 gün içinde maksimum 72 saat çalışabilir
3-bir kişi herhangi 24 saat içinde minimum 10 saat dinlenmelidir. (gün değil, herhangi 24 saat)
4-bir kişi herhangi 7 gün içinde minimum 77 saat dinlenmelidir. (gün değil, herhangi 24 saat)
5-dinlenme saati maksimum 2 periyoda bölünebilir ve bunlardan biri en az 6 saat olmalıdır.
6-iki dinlenme periyodu arasındaki süre 14 saati aşmamalıdır.

ilk dort kuralın uygulanması icin aklımdaki algoritma
bu hücrelerin hepsini ayrı ayrı isimlendirerek her hücre girişi yapıldıktan sonra günlük koşullar için önceki 23 saate ait değerlere bakarak countblank ve x'leri saydırarak eğer bu rakamlar aşılırsa o hücrelere bir renk belirleyip o renge boyamak.
Ornegin hücrelere soldan saga (a1,a2...sekilde) isim verdik. a47 isimli hücreye giriş yapıldığında (a23 ile a47 isimli hücrelerdeki x ve boş hücrelerin sayısı toplanarak yukarıda belirlenen kurallara uymuyorsa örneğin 1. kural için sarı 2. kural için kırmızı...
kural uygulatılabilir.
5 ve 6. kurallar için ne yapılabilir bilmiyorum.
ard arda gelen bos hucreleri saydırmak icin bir macrom var ama yeterli gibi gorunmuyor

Public Function MaxBlank(ByVal Evn As Range) As Long
    Dim kontrol As Long, degerler As Variant, a As Long
    degerler = Evn.Value2
    Application.Volatile
    For i = LBound(degerler, 1) To UBound(degerler, 2)
    If kontrol > a Then a = kontrol
        If IsEmpty(degerler(1, i)) Then
            kontrol = kontrol + 1
        Else
            kontrol = 0
        End If
    Next i
        MaxBlank = a
    End Function

biraz uzattım ama yardımcı olursanız çok sevinirim
selamlar