Değerli arkadaşlar daha önce siteden indirip kontrolünü sağladığım oto puantaj tablosunda 2 vardiya, 2 istirahat alanı var. Ben burda 3 vardiya ve 1 istirahat alanı olmasını istiyorum. İstirahat bölümündeki 1 vardiyaya 3'üncü çalışan vardiya olarak makroda nasıl de
Alıntı Ömer beyden hak geçmesin şimdiden teşekkürler
ğiştireceğiz. Yardımcı olursanız sevinirim. Şimdiden teşekkür ederim.
Alıntı Ömer beyden hak geçmesin şimdiden teşekkürler
Kod:
Sub puantaj()
Set s1 = Sheets("PUANTAJ")
Set s2 = Sheets("PERSONEL LİSTESİ")
Set s3 = Sheets("VARDİYA NÖBET CİZELGESİ")
Set s4 = Sheets("izin takip")
dönem = s1.[a1]
uyarı = MsgBox(s1.[B5] & " işlensin mi?" & Chr(10) & _
"Vardiya çizelgesini ve personel listesini hazırladınız mı?", vbYesNo)
If uyarı = vbYes Then
sonkişi = WorksheetFunction.Max(7, s1.Cells(Rows.Count, "A").End(3).Row)
songün = WorksheetFunction.Max(2, s3.Cells(Rows.Count, "B").End(3).Row)
sonpersonel = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)
s1.Range("A7:AJ" & sonkişi).Clear
s2.Range("A2:D" & sonpersonel).Copy: s1.[A7].PasteSpecial Paste:=xlPasteValues
son = s1.Cells(Rows.Count, "A").End(3).Row
For kişi = 7 To son
For gün = 5 To 35
If s1.Cells(2, gün) <> "" Then
If s1.Cells(kişi, "D") = "SABİT" Then
If WorksheetFunction.Weekday(s1.Cells(6, gün), 2) <= 5 Then
s1.Cells(kişi, gün) = "X"
End If
ElseIf s1.Cells(kişi, "D") = s1.Cells(1, gün) Or s1.Cells(kişi, "D") = s1.Cells(2, gün) Then
s1.Cells(kişi, gün) = "x"
End If
End If
Next
s1.Cells(kişi, "AJ").FormulaR1C1 = "=COUNTIF(RC[-31]:RC[-1],""X"")"
Next
End If
Application.CutCopyMode = False
With s1.Range("A7:AJ" & son).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With s1.Range("A7:AJ" & son).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With s1.Range("A7:AJ" & son).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With s1.Range("A7:AJ" & son).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With s1.Range("A7:AJ" & son).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With s1.Range("A7:AJ" & son).Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Range("A7:D" & son).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range("A7:D" & son).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range("A7:D" & son).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range("A7:D" & son).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range("A7:D" & son).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With Range("A7:D" & son).Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Range("AJ7:AJ" & son).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range("AJ7:AJ" & son).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range("AJ7:AJ" & son).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range("AJ7:AJ" & son).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range("A7:AJ" & son).Font
.Name = "Calibri"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("AJ7:AJ" & son).Font.Bold = True
Range("E6:AJ" & son).FormatConditions.Add Type:=xlExpression, Formula1:= _
"=HAFTANINGÜNÜ(E$6;2)>5" ' satır toplamları
Range("E6:AJ" & son).FormatConditions(Range("E6:AJ" & son).FormatConditions.Count).SetFirstPriority
With Range("E6:AJ" & son).FormatConditions(1).Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
With Range("E6:AJ" & son).FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249946592608417
End With
Range("E6:AJ" & son).FormatConditions(1).StopIfTrue = False
With Range("E7:AJ" & son)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Range("A7:D" & son)
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Range("A7:A" & son)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'İzin vs işleme
sonizin = s4.Cells(Rows.Count, "A").End(3).Row
For m = 7 To son
If WorksheetFunction.CountIf(s4.Range("A1:A" & sonizin), s1.Cells(m, "B")) >= 1 Then
For n = 2 To sonizin
If s4.Cells(n, "A") = s1.Cells(m, "B") Then
For o = 5 To 35
If s1.Cells(6, o) <> "" Then
If s1.Cells(6, o) >= s4.Cells(n, "B") And s1.Cells(6, o) < s4.Cells(n, "C") Then
s1.Cells(m, o) = s4.Cells(n, "E")
s1.Cells(m, o).Interior.Color = vbRed
End If
End If
Next
End If
Next
End If
Next
MsgBox "İşlem tamamlandı"
End Sub