Farklı Müsaitlik Günlerine Göre Nöbet Çizelgesi

halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,800
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
H

haliliyas

Katılım
2 Temmuz 2014
Mesajlar
160
Excel Vers. ve Dili
2021 Türkçe, 64bit
H

haliliyas

Katılım
2 Temmuz 2014
Mesajlar
160
Excel Vers. ve Dili
2021 Türkçe, 64bit
Son olarak aşağıdaki kod da denenebilir daha sade ve dağılım daha dengeli gibi geldi. tabi yine Sayfa1.Range("MusaitPersonel") tanimlanmis olmalı.
Iyi çalışmalar.
Kod: 
Sub ListeYap_Rs_hy()  'Sorunsuz çalışıyor _hy
'_________________________________________________________________________
If Sayfa1.[r2] = "" Or Sayfa1.[s2] = "" Then MsgBox "ay yada yıl girilmemiş": Exit Sub
Sayfa1.[a2:B33].ClearContents

Dim xP, i, xYil, xAyAd, Ay, xAySay, Gun
   xYil = Sayfa1.Range("Yıl")
  xAyAd = Application.Proper(Sayfa1.Range("Ay"))
     Ay = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
xAySay = Application.Match(xAyAd, Ay, 0)
If Not IsNumeric(xAySay) Then MsgBox "ay adı hatalı girilmiş": Exit Sub
    Gun = Array("CUMARTES*", "PAZAR", "PAZARTES*", "SAL*", "ÇARŞAMBA", "PERŞEMBE", "CUMA")
    If xAySay Mod 2 = 0 Then xPerSira = "ASC" Else xPerSira = "DESC"
'__________________________________________________________________________
dzUygun = Sayfa1.Range("MusaitPersonel")
    Set UyGun_Rs = CreateObject("ADODB.Recordset")
    With UyGun_Rs
        .Fields.Append "Kisi", 200, 100
        .Fields.Append "UyGun", 200, 100
        .Fields.Append "NobetSay", 3
        .Fields.Append "UyGunSay", 3
        .Open      
        For x = LBound(dzUygun) To UBound(dzUygun)
        xVarMi = Application.Match(dzUygun(x, 2), Array("TÜm HAfTa", ""), 0)
        If IsNumeric(xVarMi) Then dzUygun(x, 2) = "PAZARTESİ, SALI, ÇARŞAMBA, PERŞEMBE, CUMA"
            xGunSay = UBound(Split("," & dzUygun(x, 2), ","))
              .AddNew Array(0, 1, 2, 3), Array(dzUygun(x, 1), dzUygun(x, 2), 0, xGunSay)
        Next x
            .Sort = "NobetSay, UyGunSay, Kisi " & xPerSira
     End With

Dim xAySon As Byte:     xAySon = Day(DateSerial(xYil, xAySay + 1, 0))
Dim dzTarih() As Variant: ReDim dzTarih(1 To xAySon, 1 To 2)
        For i = 1 To xAySon
            dzTarih(i, 1) = DateSerial(xYil, xAySay, i)
                     xMod = dzTarih(i, 1) Mod 7
                If xMod > 1 Then
                   xGun = Gun(xMod) '
                   xFiltre = Replace("UyGun like '*" & xGun & "*'", "**", "*")
                   UyGun_Rs.Filter = xFiltre
                   If UyGun_Rs.RecordCount > 0 Then dzTarih(i, 2) = UyGun_Rs("Kisi"): UyGun_Rs("NobetSay") = UyGun_Rs("NobetSay") + 1
                End If
        Next i
Sayfa1.Range("A2").Resize(xAySon, 2) = dzTarih
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst