Yazılan ayın son pazartesinden sonra ayın sonuna kaç gün geçti.

[kelkitli]

Değerli dostlar selamlar,
Ekteki dosyada liste oluşturmayla ilgili ayın günleriyle ilgili bir hesaplama var yapamadım.Ayın son X gününden sonra ay bitinceye kadar, Ayın 1 inden itibaren Y günü kaçıncı gün? diye

 

[Orion1]

Yazılan ayın son pazartesin den ay sonuna kaç gün kalmış için Bir KTF hazırladım.Ekli dosyayı inceleyiniz.

=son_gun($A$5;1)

Function son_gun(gun As Range, kriter As Byte)
Dim tarih, yeniay, aysonu As Date
Dim i, fark As Byte
tarih = Format(DateSerial(Year(gun), Month(gun), 1), "dd.mm.yyyy")
yeniay = Format(DateAdd("m", 1, tarih))
aysonu = Format(DateAdd("d", -1, yeniay))
For i = aysonu To gun Step -1
    Pazartesi = Application.Weekday(CDate(i), 2)
    If Pazartesi = kriter Then
        ptesi = CDate(i)
        Exit For
    End If
Next
fark = CDate(aysonu) - CDate(ptesi)
son_gun = fark
End Function

 

[kelkitli]

Sayın Orion2 Selamlar,
Teşekkür ederim cevabınız için. Hazırladığınız kullanıcı tanımlı fonksiyon süper. Ancak ben bu konunun kalan kısmı için yeniden başlık açsam hoş karşılanmaz. Eğer mümkünse diğer etabınıda bir gözden geçirebilirmisiniz. Biliyorsunuz biz ancak hazır fonksiyon ve makrolarda değiştirme yapacak kadar bilgiye sahibiz. kendi hazırlama imkânımız da kopyaya dayalı. Sizler yardım ederseniz oluyor.

 

[Orion1]

Ekli dosyayı inceleyiniz.

Eğer B10 hücresine (yani 10. satıra)yazılan yaka no 5. saırdaki (mesela 52 yi bu hücreye yazarsak kırmızı olur eğer 5. satırdaki 52 farklı renkteyse yanlış vardiya yazsın

Yukarıdaki konuyu anlayamadım.

Function ilk_gun(gun As Range, kriter As Byte)
Dim tarih, son_gun As Date, sonuc2 As Date
Dim i As Date, sonuc As Byte, fark As Byte
tarih = Format(DateSerial(Year(gun), Month(gun), 1), "dd.mm.yyyy")
son_gun = DateAdd("d", 20, tarih)
For i = tarih To son_gun
    sonuc = Application.Weekday(CDate(i), 2)
    If sonuc = kriter Then
        sonuc2 = CDate(i)
        Exit For
    End If
Next
fark = CDate(sonuc2) - CDate(tarih)
ilk_gun = fark
End Function

Function yaka_noBul(alan As Range, alan2 As Range, deg As Range)
Dim hucre As Range
For Each hucre In alan
    If hucre.Value = deg Then
        adrs = Cells(hucre.Row - 1, hucre.Column).Address
        Exit For
    End If
Next
    If alan2.Value + Range(adrs).Value >= 10 Then
        sonuc = "İZİN"
        Else
        sonuc = alan2.Value + Range(adrs).Value
    End If

yaka_noBul = sonuc
End Function

 

[kelkitli]

Sayın Orion2 Selamlar,
Teşekkür ederim. Emeğine sağlık. Sağol, Varol. İşlem tamam.

 

[Orion1]

Sayın Orion2 Selamlar,
Teşekkür ederim. Emeğine sağlık. Sağol, Varol. İşlem tamam.

Rica ederim.
İyi çalışmalar.

 

[kelkitli]

Selamlar, Sayın Orion2 ben dosyayı uyarlamaya çalışırken ekteki dosyada görünen sıkıntıya düştüm. Uyarlarım diye düşünmüştüm başaramadım kusura bakmayın. Bakma imkânınız olursa memnun olurum. Ben durumu anlatma açısından
=EĞER(D10="";"";yaka_noBUl($B$5:$S$5;B9;$D$10)+1)
gibi rakamlar ekledim.

 

[Orion1]

Program sorunsuz çalışıyor.

 

[kelkitli]

52 noyu Pazartesi izin olan B10 hücresine yazınca B11 hücresine B9+F4 yazmalı
52 noyu Salı izin olan E10 hücresine yazınca E11 hücresine E9+F4 yazmalı

 

[kelkitli]

Sayın Orion2 Selamlar,
Ekteki dosyada ben problemi bir şekilde sonuçlandırdım. Emeğiniz için teşekkür ederim.