Aşağıdakiler ise yazılan kodlar;
MAYIS Sayfası kod bölümünde;
Sub sayfa_analiz()
Application.ScreenUpdating = False
On Error Resume Next
Range("z2:ad65536").ClearContents
For i = 0 To 30
sonsatir = Range("z65536").End(xlUp).Row + 1
Cells(sonsatir, "z") = Format(Cells(1, 1) + i, "dd.mm.yyyy")
If Month(Cells(1, 1)) <> Month(Cells(sonsatir, "z")) Then Cells(sonsatir, "z") = ""
Next i
For i = 5 To 35
For k = 3 To 8
If Cells(i, k) <> "" Then
sonsatir = Range("aa65536").End(xlUp).Row + 1
Cells(sonsatir, "aa") = Cells(i, 1)
Cells(sonsatir, "ab") = Cells(i, k)
If k <= 4 Then Cells(sonsatir, "ac") = "NB"
If k >= 5 Then Cells(sonsatir, "ac") = "M"
If k <= 4 Then Cells(sonsatir, "ad") = 24
If k >= 5 Then Cells(sonsatir, "ad") = 7 ' Bu satırın sonundaki rakamı değiştirebilirsiniz
End If
Next k
Next i
For k = 2 To Range("r65536").End(xlUp).Row
For i = 2 To Range("z65536").End(xlUp).Row
If Format(Cells(i, "z"), "dd.mm.yyyy") >= Format(Cells(k, "s"), "dd.mm.yyyy") And Format(Cells(i, "z"), "dd.mm.yyyy") <= Format(Cells(k, "t"), "dd.mm.yyyy") Then
sonsatir = Range("aa65536").End(xlUp).Row + 1
Cells(sonsatir, "aa") = Cells(i, "z")
Cells(sonsatir, "ab") = Cells(k, "r")
Cells(sonsatir, "ac") = Cells(k, "u")
Cells(sonsatir, "ad") = Cells(k, "u")
End If
Next i
Next k
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub
PUANTAJ sayfası kod bölümünde;
Sub puantaja_getir()
Application.ScreenUpdating = False
On Error Resume Next
Set s2 = ThisWorkbook.Worksheets(Cells(2, 1).Value)
Range("d8:ah24").ClearContents
Range("d8:ah24").Interior.ColorIndex = xlNone
For i = 4 To 34
Cells(8, i) = Cells(1, 1) + (i - 4)
If Month(Cells(8, i)) <> Month(Cells(1, 1)) Then Cells(8, i) = ""
If Cells(8, i) <> "" And Weekday(Cells(8, i)) = 7 Then Cells(8, i).Interior.ColorIndex = Cells(1, 1).Interior.ColorIndex
If Cells(8, i) <> "" And Weekday(Cells(8, i)) = 1 Then Cells(8, i).Interior.ColorIndex = Cells(2, 1).Interior.ColorIndex
Next i
For i = 10 To 25
For k = 4 To 34
For z = 2 To s2.Range("aa65536").End(xlUp).Row
If Format(s2.Cells(z, "aa"), "dd.mm.yyyy") = Format(Cells(8, k), "dd.mm.yyyy") And s2.Cells(z, "ab") = Cells(i, "c") Then
Cells(i, k) = s2.Cells(z, "ad")
End If
Next z
Next k
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub
Sub özelgün_işlemi()
Application.ScreenUpdating = False
On Error Resume Next
Set s2 = ThisWorkbook.Worksheets(Cells(2, 1).Value)
For i = 10 To 25
For k = 4 To 34
For z = 2 To s2.Range("af65536").End(xlUp).Row
If Format(s2.Cells(z, "af"), "dd.mm.yyyy") = Format(Cells(8, k), "dd.mm.yyyy") And Cells(i, k) = s2.Cells(z, "ag") Then
Cells(i, k) = s2.Cells(z, "ah")
Cells(i, k).Interior.ColorIndex = Cells(1, 1).Interior.ColorIndex
End If
Next z
Next k
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub