DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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
Yukarıdaki konuyu anlayamadım.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
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
Rica ederim.Sayın Orion2 Selamlar,
Teşekkür ederim. Emeğine sağlık. Sağol, Varol. İşlem tamam.