Procedure too large Как уменьшить данный код? - VBA

Формулировка задачи:

Добрый день! Прошу помощи, как можно уменьшить код, можно использовать и подпроцедуры и все остальные прелести VBA. Сам пробую, не получается.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
 
''----------------------------- День 2 -----------------------------------
''
'---------------- 1 --------------------
    If Not Intersect(Target, Range("$Z$16")) Is Nothing Then 'Отслеживает изменение в диапазоне
        Cancel = True
        ActiveSheet.Unprotect
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                With Range("V16:X16").Interior
                        .Color = 5287936 'Г‡ГҐГ«ГҐГ*Г»Г©
                        Range("AA17") = Range("AA17").Value + Range("Y16").Value
                End With
            Else
                Target = vbNullString
                With Range("V16:X16").Interior
                        .Pattern = xlNone 'ГЌГҐГІ Г§Г*Г«ГЁГўГЄГЁ
                        Range("AA17") = Range("AA17").Value - Range("Y16").Value
                End With
            End If
    ActiveSheet.Protect
    End If
'---------------- 2 --------------------
    If Not Intersect(Target, Range("$Z$17")) Is Nothing Then 'ГЋГІГ±Г«ГҐГ¦ГЁГўГ*ГҐГІ ГЁГ§Г¬ГҐГ*ГҐГ*ГЁГї Гў Г¤ГЁГ*ГЇГ*Г§Г®Г*ГҐ
        Cancel = True
        ActiveSheet.Unprotect
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                With Range("V17:X17").Interior
                        .Color = 5287936
                        Range("AA17") = Range("AA17").Value + Range("Y17").Value
                End With
            Else
                Target = vbNullString
                With Range("V17:X17").Interior
                        .Pattern = xlNone
                        Range("AA17") = Range("AA17").Value - Range("Y17").Value
                End With
            End If
    ActiveSheet.Protect
    End If
'---------------- 3 --------------------
    If Not Intersect(Target, Range("$Z$18")) Is Nothing Then 'ГЋГІГ±Г«ГҐГ¦ГЁГўГ*ГҐГІ ГЁГ§Г¬ГҐГ*ГҐГ*ГЁГї Гў Г¤ГЁГ*ГЇГ*Г§Г®Г*ГҐ
        Cancel = True
        ActiveSheet.Unprotect
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                With Range("V18:X18").Interior
                        .Color = 5287936
                        Range("AA17") = Range("AA17").Value + Range("Y18").Value
                End With
            Else
                Target = vbNullString
                With Range("V18:X18").Interior
                        .Pattern = xlNone
                        Range("AA17") = Range("AA17").Value - Range("Y18").Value
                End With
            End If
    ActiveSheet.Protect
    End If
'---------------- 4 --------------------
    If Not Intersect(Target, Range("$Z$19")) Is Nothing Then 'ГЋГІГ±Г«ГҐГ¦ГЁГўГ*ГҐГІ ГЁГ§Г¬ГҐГ*ГҐГ*ГЁГї Гў Г¤ГЁГ*ГЇГ*Г§Г®Г*ГҐ
        Cancel = True
        ActiveSheet.Unprotect
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                With Range("V19:X19").Interior
                        .Color = 5287936
                        Range("AA17") = Range("AA17").Value + Range("Y19").Value
                End With
            Else
                Target = vbNullString
                With Range("V19:X19").Interior
                        .Pattern = xlNone
                        Range("AA17") = Range("AA17").Value - Range("Y19").Value
                End With
            End If
    ActiveSheet.Protect
    End If
'---------------- 5 --------------------
    If Not Intersect(Target, Range("$Z$20")) Is Nothing Then 'ГЋГІГ±Г«ГҐГ¦ГЁГўГ*ГҐГІ ГЁГ§Г¬ГҐГ*ГҐГ*ГЁГї Гў Г¤ГЁГ*ГЇГ*Г§Г®Г*ГҐ
        Cancel = True
        ActiveSheet.Unprotect
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                With Range("V20:X20").Interior
                        .Color = 5287936
                        Range("AA17") = Range("AA17").Value + Range("Y20").Value
                End With
            Else
                Target = vbNullString
                With Range("V20:X20").Interior
                        .Pattern = xlNone
                        Range("AA17") = Range("AA17").Value - Range("Y20").Value
                End With
            End If
    ActiveSheet.Protect
    End If
'---------------- 6 --------------------
    If Not Intersect(Target, Range("$Z$21")) Is Nothing Then 'ГЋГІГ±Г«ГҐГ¦ГЁГўГ*ГҐГІ ГЁГ§Г¬ГҐГ*ГҐГ*ГЁГї Гў Г¤ГЁГ*ГЇГ*Г§Г®Г*ГҐ
        Cancel = True
        ActiveSheet.Unprotect
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                With Range("V21:X21").Interior
                        .Color = 5287936
                        Range("AA17") = Range("AA17").Value + Range("Y21").Value
                End With
            Else
                Target = vbNullString
                With Range("V21:X21").Interior
                        .Pattern = xlNone
                        Range("AA17") = Range("AA17").Value - Range("Y21").Value
                End With
            End If
    ActiveSheet.Protect
    End If
'---------------- 7 --------------------
    If Not Intersect(Target, Range("$Z$22")) Is Nothing Then 'ГЋГІГ±Г«ГҐГ¦ГЁГўГ*ГҐГІ ГЁГ§Г¬ГҐГ*ГҐГ*ГЁГї Гў Г¤ГЁГ*ГЇГ*Г§Г®Г*ГҐ
        Cancel = True
        ActiveSheet.Unprotect
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                With Range("V22:X22").Interior
                        .Color = 5287936
                        Range("AA17") = Range("AA17").Value + Range("Y22").Value
                End With
            Else
                Target = vbNullString
                With Range("V22:X22").Interior
                        .Pattern = xlNone
                        Range("AA17") = Range("AA17").Value - Range("Y22").Value
                End With
            End If
    ActiveSheet.Protect
    End If
'---------------- 8 --------------------
    If Not Intersect(Target, Range("$Z$23")) Is Nothing Then 'ГЋГІГ±Г«ГҐГ¦ГЁГўГ*ГҐГІ ГЁГ§Г¬ГҐГ*ГҐГ*ГЁГї Гў Г¤ГЁГ*ГЇГ*Г§Г®Г*ГҐ
        Cancel = True
        ActiveSheet.Unprotect
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                With Range("V23:X23").Interior
                        .Color = 5287936
                        Range("AA17") = Range("AA17").Value + Range("Y23").Value
                End With
            Else
                Target = vbNullString
                With Range("V23:X23").Interior
                        .Pattern = xlNone
                        Range("AA17") = Range("AA17").Value - Range("Y23").Value
                End With
            End If
    ActiveSheet.Protect
    End If
'---------------- 9 --------------------
    If Not Intersect(Target, Range("$Z$24")) Is Nothing Then 'ГЋГІГ±Г«ГҐГ¦ГЁГўГ*ГҐГІ ГЁГ§Г¬ГҐГ*ГҐГ*ГЁГї Гў Г¤ГЁГ*ГЇГ*Г§Г®Г*ГҐ
        Cancel = True
        ActiveSheet.Unprotect
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                With Range("V24:X24").Interior
                        .Color = 5287936
                        Range("AA17") = Range("AA17").Value + Range("Y24").Value
                End With
            Else
                Target = vbNullString
                With Range("V24:X24").Interior
                        .Pattern = xlNone
                        Range("AA17") = Range("AA17").Value - Range("Y24").Value
                End With
            End If
    ActiveSheet.Protect
    End If
End Sub

Вот таких дней получается 31, и в каждом по 9 условий (изменений по двойному клику в ячейке) и все они находятся в одной процедуре. Получается очень длинный код и вылазит ошибка "Procedure too large". Вот и вытекает вопрос - как можно уменьшить код? Большая просьба, если можно, написать код.

Решение задачи: «Procedure too large Как уменьшить данный код?»

textual
                            Листинг программы 
                        

                            Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Unprotect
Call DaysUniv(Target, "$Z$16:$Z$24", "AA17", Cancel)
Call DaysUniv(Target, "$M$16:$M$24", "N17", Cancel)
ActiveSheet.Protect
End Sub
Private Sub DaysUniv(ByVal Target As Range, ByVal strAddrRange As String, ByVal strAddrCell As String, ByRef Cancel As Boolean)
Dim rngObj As Range
If Intersect(Target, Range(strAddrRange)) Is Nothing Then Exit Sub Else Set rngObj = Intersect(Target, Range(strAddrRange))
    Cancel = True
        
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                rngObj.Offset(0, -4).Resize(1, 3).Interior.Color = 5287936
                Range(strAddrCell) = Range(strAddrCell).Value + rngObj.Offset(0, -1).Value
            Else
                Target = vbNullString
                rngObj.Offset(0, -4).Resize(1, 3).Interior.Pattern = xlNone
                Range(strAddrCell) = Range(strAddrCell).Value - rngObj.Offset(0, -1).Value
             
            End If
    
 
Set rngObj = Nothing
End Sub
                        