Resmi ve Tatil Günlerini Renk atama

[mehce]

Hastanede görevliyim.Aylık Nöbet cizelgemiz var. Bunda bazı formüllemeler yapmak istiyorum.Beceremedim yardımcı olursanız sevinirim.
1- Bu bir ay içindeki resmi tatilleri farklı renklerde olmasını koşullu biçimlendirme ile nasıl yaparız? (cmt, pazar, ve 23 nisan 19 mayıs vs. )
2- Bunların yanlarındaki nöbetçi personelinde İsmi renk değiştirebilirmi?

Bunlarla ilgili daha önceki tüm örnekler silinmiş.

 

[dEdE]

Merhaba,
Forumdan almıştım.
Başlangıç için bir fikir verir.

 

[halit3]

ekli dosyaya bakınız

 

[ziya]

Merhaba,
Aşağıdaki linkte Puantaj Programı var. Hafta Tatili ve Resmi Tatilleri koşullu biçimlendirme ile belirgin hale getiriyor. Hafta tatili için hiçbir bilgi girmenize gerek yok, sistem tarihi itibariyle belirliyor. Bayram ve diğer resmi tatilleri yıl bazında manuel olarak A sütununa giemwniz gerekiyor. Değişiklik gerekirse yardımcı olurum.
Selamlar,
http://www.excel.web.tr/f124/ssk-eksik-gun-bildirim-puantaj-t48374.html

 

[mehce]

Bana yardımcı olan tüm arkadaşlarıma sonsuz teşekkürler.

 

[mehce]

Sayfamda bir hata var

Tekrar merhaba bana gönderdiğiniz örneklerden bir liste yaptım tüm yıldaki resmi tatil günlerini her ay girildiğinde koşullu biçimlendirme yaptırdım fakat 29 ekimi almıyor ve resmi tatil listesine örn. 12 Mayıs dediğimde biçimlendirme yapmıyor nerede hata yaptım acaba bakabilirseniz sevinirim

 

[Merhum İdris SERDAR]

Tekrar merhaba bana gönderdiğiniz örneklerden bir liste yaptım tüm yıldaki resmi tatil günlerini her ay girildiğinde koşullu biçimlendirme yaptırdım fakat 29 ekimi almıyor ve resmi tatil listesine örn. 12 Mayıs dediğimde biçimlendirme yapmıyor nerede hata yaptım acaba bakabilirseniz sevinirim

İkinici koşulun formülünü aşağıdaki şekilde deneyin.

=VLOOKUP(B5;G:G;1;0)=B5
=DÜŞEYARA(B5;G:G;1;0)=B5


.

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak koşullu biçimlendirmedeki ikinci koşulu silin ve birinci koşula aşağıdaki formülü uygulayın.

=EĞER(YADA(HAFTANINGÜNÜ($B5;2)=6;HAFTANINGÜNÜ($B5;2)=7;EĞERSAY($G:$G;$B5)>0);DOĞRU;YANLIŞ)

 

[mehce]

DÜŞEYARA işimi gördü çok teşekkürler Korhan Bey ilginizden dolayı teşekkürler.

 

[onrat33]

Tatil günlerini kırmızı renkli yazı ile göstere bilirmiyiz.
teşekkürler

 

[halit3]

alternatif dosya yeni eklemeler var

 

[abazya]

Dosyayı indiremedim.

 

[halit3]

dosyayı yeniden ekledim 12 sıralı masaja

 

[abazya]

Yeni eklemiş olduğunuz dosyayıda (11. Mesajda) indiremedim. Göndermiş olduğum mesajdaki (12. Mesaj) hatayı veriyor.

 

[halit3]

arkadaşlar dosyayı indirebilen varmı

 

[Korhan Ayhan]

Selamlar,

Halit bey,

Nod32 virüs programı dosyanızda "POLY.MACRO" isimli virüsü tesbit ettiği için dosyanız indirilemiyor.

 

[halit3]

sayın korhan ayhan bey evet dediğiniz doğru genelde makro olan dosyaları not32 anti virüs prağramı POLY.MACRO virüsü buldu uyarısı veriyor inanki neden olduğunu anlamıyorum bendede bu sorunlar vardı avast anti virüs proğramını kullanıyorum bu sıkıntılar yok dosyanın içinde bir adet SpinButton1 düğmesi var birde CommandButton1 düğmesi var geri kalan kodlar aşağıdaki gibi kodları takvim sayfasına kopyalayınız çalışması lazım

Const sat = 5
Const sut = 4
Const pat = "YATAY"
Dim Tarih As Long
Dim t As String
Dim r As String
Dim Ayin_Ilk_Gunu As Date, Ayin_Son_Gunu As Date, Hedef As Range, Adres As String

Private Sub CommandButton1_Click()
deg1 = ThisWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule.Lines(1, 1)
kat = Val(Trim(Mid(deg1, 13, Len(deg1))))
deg2 = ThisWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule.Lines(2, 1)
kat1 = Val(Trim(Mid(deg2, 13, Len(deg2))))
deg3 = ThisWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule.Lines(3, 1)
kat2 = Mid(deg3, 14, 5)
SATIRNO = InputBox("Satır numarasını giriniz.", "UYARI!", kat)
SUTUNNO = InputBox("Sutun numarasını giriniz.", "UYARI!", kat1)
YATAYNO = InputBox("YATAY" & Chr(10) & Chr(10) & _
"veya" & Chr(10) & Chr(10) & _
"DİKEY" & Chr(10) & Chr(10) & _
"Büyük harflerle Birisini yazınız.", "UYARI!", kat2)

If SATIRNO = "" Then
MsgBox "satır numarassını girmediniz"
Exit Sub
End If
If SUTUNNO = "" Then
MsgBox "sutun numarasını girmediniz"
Exit Sub
End If
If YATAYNO = "" Then
MsgBox "Sağ tarafa veya Aşağı bölümünü yazmadınız"
Exit Sub
End If
If YATAYNO = "YATAY" Then
YATAYNO = "YATAY"
Else
YATAYNO = "DİKEY"
End If

If kat2 = "YATAY" Then
t = Columns(sut).Address(0, 0)
m = Left(t, InStr(t, ":") - 1)
r = Columns(sut + 30).Address(0, 0)
n = Left(r, InStr(r, ":") - 1)
Worksheets(ActiveSheet.Name).Range(m & sat & ":" & n & sat + 1).FormatConditions.Delete
Worksheets(ActiveSheet.Name).Range(m & sat & ":" & n & sat + 1).ClearContents
End If
If kat2 = "DİKEY" Then
t = Columns(sut).Address(0, 0)
n = Columns(sut + 1).Address(0, 0)
m = Left(t, InStr(t, ":") - 1)
r = Left(n, InStr(n, ":") - 1)
Worksheets(ActiveSheet.Name).Range(m & sat & ":" & r & 30 + sat).FormatConditions.Delete
Worksheets(ActiveSheet.Name).Range(m & sat & ":" & r & 30 + sat).ClearContents
End If


ThisWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule.deleteLines 1
ThisWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule.InsertLines 1, "Const sat=" & SATIRNO
ThisWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule.deleteLines 2
ThisWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule.InsertLines 2, "Const sut=" & SUTUNNO
ThisWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule.deleteLines 3
ThisWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule.InsertLines 3, "Const pat=" & """" & YATAYNO & """"
MsgBox "işlem tamam"
End Sub
Private Sub SpinButton1_SpinUp()
Ayin_Son_Gunu = DateSerial(Year(Now), Month(Now), 1) - 1
Tarih = Tarih + Val(Mid(Ayin_Son_Gunu, 1, 2))
yer = Date + Tarih
Ayin_Ilk_Gunu = DateSerial(Year(yer), Month(yer), 1)
Ayin_Son_Gunu = DateSerial(Year(yer), Month(yer) + 1, 1) - 1
MsgBox "İlgili Ay : " & Ayin_Ilk_Gunu & " - " & Ayin_Son_Gunu

deg3 = ThisWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule.Lines(3, 1)
kat2 = Mid(deg3, 14, 5)
If kat2 = "YATAY" Then
deneme
Else
deneme1
End If
End Sub
Private Sub SpinButton1_SpinDown()
Ayin_Son_Gunu = DateSerial(Year(Now), Month(Now), 1) - 1
Tarih = Tarih - Val(Mid(Ayin_Son_Gunu, 1, 2))
yer = Date + Tarih
Ayin_Ilk_Gunu = DateSerial(Year(yer), Month(yer), 1)
Ayin_Son_Gunu = DateSerial(Year(yer), Month(yer) + 1, 1) - 1
MsgBox "İlgili Ay : " & Ayin_Ilk_Gunu & " - " & Ayin_Son_Gunu
deg3 = ThisWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule.Lines(3, 1)
kat2 = Mid(deg3, 14, 5)
If kat2 = "YATAY" Then
deneme
Else
deneme1
End If
End Sub
Private Sub deneme()

yer = Date + Tarih
t = Columns(sut).Address(0, 0)
m = Left(t, InStr(t, ":") - 1)
r = Columns(sut + 30).Address(0, 0)
n = Left(r, InStr(r, ":") - 1)
Range(m & sat & ":" & n & sat + 1).ClearContents

Ayin_Ilk_Gunu = DateSerial(Year(yer), Month(yer), 1)
Ayin_Son_Gunu = DateSerial(Year(yer), Month(yer) + 1, 1) - 1
Set Hedef = Range(m & sat)
Hedef = Mid(Ayin_Ilk_Gunu, 1, 2)
With Hedef
Adres = .Address(True, False)
.Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=R[1]C=""Cumartesi"""
Selection.FormatConditions(1).Font.ColorIndex = 2
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=R[1]C=""Pazar"""
Selection.FormatConditions(2).Font.ColorIndex = 2
Selection.FormatConditions(2).Interior.ColorIndex = 3


If Val(Mid(yer, 4, 2)) = 1 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=EĞER(RC>0;METNEÇEVİR(RC;""GG"")=""01"";0)"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If

If Val(Mid(yer, 4, 2)) = 4 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=RC=23"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
If Val(Mid(yer, 4, 2)) = 5 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=RC=19"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
If Val(Mid(yer, 4, 2)) = 8 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=RC=30"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
If Val(Mid(yer, 4, 2)) = 10 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=EĞER(RC>0;METNEÇEVİR(RC;""GG"")=""29"" ;0)"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
End With


With Hedef(2, 1)
Adres = .Address(True, False)
Selection.NumberFormat = "General"
.Select
.Orientation = 90
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Cumartesi"""
Selection.FormatConditions(1).Font.ColorIndex = 2
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Pazar"""
Selection.FormatConditions(2).Font.ColorIndex = 2
Selection.FormatConditions(2).Interior.ColorIndex = 3
If Val(Mid(yer, 4, 2)) = 1 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=EĞER(R[-1]C>0;METNEÇEVİR(R[-1]C;""GG"")=""01"";0)"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
If Val(Mid(yer, 4, 2)) = 4 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=R[-1]C=23"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If

If Val(Mid(yer, 4, 2)) = 5 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=R[-1]C=19"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
If Val(Mid(yer, 4, 2)) = 8 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=R[-1]C=30"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
If Val(Mid(yer, 4, 2)) = 10 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=R[-1]C=29"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If

End With
Hedef.DataSeries Rowcol:=xlRows, Type:=xlChronological, Date:=xlDay, Step:=1, stop:=CDbl(Mid(Ayin_Son_Gunu, 1, 2)), Trend:=False
Hedef.AutoFill Destination:=Range(Hedef, Hedef.End(xlToRight)), Type:=xlFillDefault
Hedef.DataSeries Rowcol:=xlRows, Type:=xlChronological, Date:=xlDay, Step:=1, stop:=CDbl(Mid(Ayin_Son_Gunu, 1, 2)), Trend:=False
Hedef(2, 1).AutoFill Destination:=Range(Hedef(2, 1), Hedef.End(xlToRight)(2, 1)), Type:=xlFillDefault
For i = sut To Val(Mid(Ayin_Son_Gunu, 1, 2)) + sut - 1
Cells(sat + 1, i) = Format(Cells(sat, i) + Ayin_Ilk_Gunu - 1, "DDDD")
Next
Set Hedef = Nothing
End Sub

Private Sub deneme1()
yer = Date + Tarih
t = Columns(sut).Address(0, 0)
n = Columns(sut + 1).Address(0, 0)
m = Left(t, InStr(t, ":") - 1)
r = Left(n, InStr(n, ":") - 1)
Range(m & sat & ":" & r & 30 + sat).ClearContents

Ayin_Ilk_Gunu = DateSerial(Year(yer), Month(yer), 1)
Ayin_Son_Gunu = DateSerial(Year(yer), Month(yer) + 1, 1) - 1
Set Hedef = Range(m & sat)
Hedef = Mid(Ayin_Ilk_Gunu, 1, 2)
With Hedef
Adres = .Address(True, False)
.Select
Selection.FormatConditions.Delete

Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=RC[1]=""Cumartesi"""
Selection.FormatConditions(1).Font.ColorIndex = 2
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=RC[1]=""Pazar"""
Selection.FormatConditions(2).Font.ColorIndex = 2
Selection.FormatConditions(2).Interior.ColorIndex = 3

If Val(Mid(yer, 4, 2)) = 1 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=EĞER(RC>0;METNEÇEVİR(RC;""GG"")=""01"";0)"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If

If Val(Mid(yer, 4, 2)) = 4 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=RC=23"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
If Val(Mid(yer, 4, 2)) = 5 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=RC=19"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
If Val(Mid(yer, 4, 2)) = 8 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=RC=30"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
If Val(Mid(yer, 4, 2)) = 10 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=EĞER(RC>0;METNEÇEVİR(RC;""GG"")=""29"" ;0)"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
End With


With Hedef(1, 2)
Adres = .Address(True, False)
Selection.NumberFormat = "General"
.Select
.Orientation = 90
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Cumartesi"""
Selection.FormatConditions(1).Font.ColorIndex = 2
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Pazar"""
Selection.FormatConditions(2).Font.ColorIndex = 2
Selection.FormatConditions(2).Interior.ColorIndex = 3
If Val(Mid(yer, 4, 2)) = 1 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=EĞER(RC[-1]>0;METNEÇEVİR(RC[-1];""GG"")=""01"";0)"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If

If Val(Mid(yer, 4, 2)) = 4 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=RC[-1]=23"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If

If Val(Mid(yer, 4, 2)) = 5 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=RC[-1]=19"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
If Val(Mid(yer, 4, 2)) = 8 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=RC[-1]=30"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If
If Val(Mid(yer, 4, 2)) = 10 Then
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=RC[-1]=29"
Selection.FormatConditions(3).Font.ColorIndex = 2
Selection.FormatConditions(3).Interior.ColorIndex = 3
End If

Selection.Orientation = 0
End With

Hedef.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, stop:=CDbl(Mid(Ayin_Son_Gunu, 1, 2)), Trend:=False
Hedef.AutoFill Destination:=Range(Hedef, Hedef.End(xlDown)), Type:=xlFillDefault
Hedef.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, stop:=CDbl(Mid(Ayin_Son_Gunu, 1, 2)), Trend:=False
Hedef(1, 2).AutoFill Destination:=Range(Hedef(1, 2), Hedef.End(xlDown)(1, 2)), Type:=xlFillDefault

For i = sat To Val(Mid(Ayin_Son_Gunu, 1, 2)) + sat - 1
Cells(i, sut + 1) = Format(Cells(i, sut) + Ayin_Ilk_Gunu - 1, "DDDD")
Next
Set Hedef = Nothing
End Sub
Private Sub Worksheet_Activate()
Tarih = 0
End Sub

 

[Necdet]

Tatil günlerini kırmızı renkli yazı ile göstere bilirmiyiz.
teşekkürler

Ekli dosyayı inceleyiniz.

B5:C35 aralığına koşullu biçimlendirme uygulanmıştır.

Koşullu Biçimlendirme Formül :

=YADA(HAFTANINGÜNÜ($B5;2)>5;EĞERSAY($G$2:$G$14;$B5)>0)

 

[onrat33]

Necdet bey çok teşekkürler

 

[anteplim27]

arkadaşlar benimde bir sorunum var günlük devam çizelgesi indirdim netten. ama orda resmi tatil, hafta sonu tatillerini renkli göstermek için ne yapmalıyım. yardımcı olursanız menmun olurum.