تراجع عن اعطاء درجة

Sub UndoMarks()

    Dim i As Long

    Application.ScreenUpdating = False

        For i = 6 To 45

            If InStr(Range("P" & i).Value, Chr(209) & Chr(199) & Chr(211) & Chr(200)) Then

                With Range("D" & i & ":K" & i)

                    .Replace What:="49.5 50", Replacement:="49.5"

                    .Replace What:="49 50", Replacement:="49"

                    .Replace What:="48.5 50", Replacement:="48.5"

                    .Replace What:="48 50", Replacement:="48"

                    .Replace What:="47.5 50", Replacement:="47.5"

                    .Replace What:="47 50", Replacement:="47"

                    .Replace What:="46.5 50", Replacement:="46.5"

                    .Replace What:="46 50", Replacement:="46"

                    .Replace What:="45.5 50", Replacement:="45.5"

                    .Replace What:="45 50", Replacement:="45"

                End With

            End If

        Next i

        With Range("D6:K45").Font

            .Bold = True

            .Name = "Arial"

            .Size = 12

            .Strikethrough = False

            .Superscript = False

            .Subscript = False

            .OutlineFont = False

            .Shadow = False

            .Underline = xlUnderlineStyleNone

            .Color = -65536

            .TintAndShade = 0

            .ThemeFont = xlThemeFontMinor

        End With

    Application.ScreenUpdating = True

End Sub