Makromda revizyon ihtiyacı.

[burhancavus61]

Merhaba arkadaşlar. Bu kodu KORHAN hocam hazırlamıştı Allah razı olsun çok işimi gördü. Sitedeki arkadaşlarda yine aynı şekilde yardımcı oldu. Bunları söylemeden geçemedim üzerimde çok emeği var buranın.

Şimdi derdime yeni birisi eklendi aşağıdaki kodda revizyona ihtiyacım oldu. Range("I" & i).Value = [BR1] satırındaki kod ile [BR1] hücresinden fonksiyonla değiştirdiğim "AT" ve "/" kodlarını hücrelere yazıyorum. 30 gün için tüm kişilere ya "AT" yada "/" kodlarını herkese aynı uyguluyorum. [BR1] kişilere göre "AT" veya "/" yapmak istiyorum. Kodda düzenleme yapabilirmisiniz çünkü benim kapasitem buna yetersiz .

Sub puantele()

    sor = MsgBox("Puantaj Bilgilerini temizlemek ve YENİ PUANTAJ oluşturmak istiyormusunuz? Eğer EVET derseniz kaydı geri alamazsınız.!!!", 20, "UYARI")
    If sor = vbNo Then Exit Sub

    sor = MsgBox("Eminmisiniz! Aksi halde tüm puantaj bilgilerini tekrar girmek zorunda kalabilirsiniz. Bu işlem kişi başoı ortalama 1,5 sn. sürecek...", 20, "SON UYARI")
    If sor = vbNo Then Exit Sub

    Application.ScreenUpdating = False
    Application.EnableCancelKey = xlDisabled
    Application.EnableEvents = False

    ActiveSheet.Unprotect "61"
    Range("I6:AM130").Select
    Selection.ClearContents
    Range("I6").Select


tarihkontrol = Range("I5").Value
PTARIH = Range("I5").Value

Dim SonSat As Long
SonSat = Range("E" & Rows.Count).End(xlUp).row

'1. Tarih
If tarihkontrol = "" Then
GoTo 2
Else
If Weekday(PTARIH, vbMonday) = 1 Or Weekday(PTARIH, vbMonday) = 2 Or Weekday(PTARIH, vbMonday) = 3 Or Weekday(PTARIH, vbMonday) = 4 Or Weekday(PTARIH, vbMonday) = 5 Then
For i = 6 To SonSat
Range("I" & i).Value = "X"
Next i
Else
If Weekday(PTARIH, vbMonday) = 6 Then
For i = 6 To SonSat
Range("I" & i).Value = [BR1]
Next i
Else
For i = 6 To SonSat
Range("I" & i).Value = "P"
Next i
End If
End If
End If
.
.
.
.
.
'31. Tarih
31
tarihkontrol = Range("AM5").Value
PTARIH = Range("AM5").Value
If tarihkontrol = "" Then
GoTo Son
Else
If Weekday(PTARIH, vbMonday) = 1 Or Weekday(PTARIH, vbMonday) = 2 Or Weekday(PTARIH, vbMonday) = 3 Or Weekday(PTARIH, vbMonday) = 4 Or Weekday(PTARIH, vbMonday) = 5 Then
For i = 6 To SonSat
Range("AM" & i).Value = "X"
Next i
Else
If Weekday(PTARIH, vbMonday) = 6 Then
For i = 6 To SonSat
Range("AM" & i).Value = [BR1]
Next i
Else
For i = 6 To SonSat
Range("AM" & i).Value = "P"
Next i
End If
End If
End If

Son:
Dim Veri As Range
Sheets("Puantaj").Select
ActiveSheet.Unprotect "61"
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
For Each Veri In Range("I6:AM130")
If Veri.DisplayFormat.Interior.ColorIndex = 36 Then
If Cells(Veri.row, "E") <> "" Then Veri.Value = "B"
End If
Next

On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
For Each Veri In Range("I6:AM130")
If Veri.DisplayFormat.Interior.ColorIndex = 35 Then
If Cells(Veri.row, "E") <> "" Then Veri.Value = "/"
End If
Next

ActiveSheet.Protect "61", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True

MsgBox "İşleminiz tamamlanmıştır. 'X' Normal Çalışma, 'AT' Cumartesi, 'P' Pazar, '/' Arefe ve 'B' Bayram günleri Puantaja işlenmiştir. Artık diğer puantaj kayıtlarınızı işleyebilirsiniz..", vbInformation
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub