Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    aa = ActiveSheet.Name
    If aa = "база" Then
        'вычисления формул вручную
        Application.Calculation = xlManual
    Else
        'вычисления формул автоматически
        Application.Calculation = xlAutomatic
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'выделение ячеек
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    aa = Target.Row
    ab = Target.Column
    ba = Cells(Rows.Count, "a").End(xlUp).Row - 1
    'работаем в пределах таблицы
    If aa < ba And ab < 10 Then
        'если выделено > 1 ячейки
        If Target.Cells.Count > 1 Then
            'обновляем формулы
            Call formula_
        'если выделена 1 ячейка
        Else
            'разукрасим
            Range("a1:i" & ba).Interior.ColorIndex = 0
            Range(Cells(aa, "a"), Cells(aa, "i")).Interior.ColorIndex = 38
            Range(Cells(1, ab), Cells(ba, ab)).Interior.ColorIndex = 24
        End If
    'если выделение за пределами таблицы
    Else
        'уберем цветное выдиление
        Range("a1:i" & ba).Interior.ColorIndex = 0
    End If
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    'изменение ячеек
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    aa = Target.Row
    ab = Target.Column
    ba = Cells(Rows.Count, "a").End(xlUp).Row - 1
    'работаем в пределах таблицы
    If aa < ba And ab < 10 Then
        'обновляем формулы
        Call formula_
    End If
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Sub u_18()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    aa = Cells(Rows.Count, "a").End(xlUp).Row - 1
    ab = Application.Max(Range("a1:a" & aa))
    For ac = 1 To ab
        ad = Application.Match(ac, Range("a1:a" & aa), 0) + 1
        If ac < ab Then
            ae = Application.Match(ac + 1, Range("a1:a" & aa), 0) - 1
        Else
            ae = aa
        End If
        af = Range("a" & ad).Value
        If af = "" Then
            Range("a" & ad & ":a" & ae) = ac
        Else
            Range("a" & ad & ":a" & ae).ClearContents
        End If
    Next
    ab = Application.Max(Range("c1:c" & aa))
    For ac = 1 To ab
        ad = Application.Match(ac, Range("c1:c" & aa), 0) + 1
        If ac < ab Then
            ae = Application.Match(ac + 1, Range("c1:c" & aa), 0) - 1
        Else
            ae = aa
        End If
        If af = "" Then
            Range("c" & ad & ":c" & ae) = ac
        Else
            Range("c" & ad & ":c" & ae).ClearContents
        End If
    Next
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
Sub formula_()
    Application.ScreenUpdating = True
    ba = Cells(Rows.Count, "a").End(xlUp).Row - 1
    Range("b3:b" & ba).FormulaR1C1 = "=ROW()-2"
    Range("b3:b" & ba) = Range("b3:b" & ba).Value
    ca = Range("d" & ba).Value
    Range("d3:d" & ba).FormulaR1C1 = "=IF(RC[-1],IF(RC[-1]=R[-1]C[-1],IF(RC[1],R[-1]C+1,R[-1]C),IF(RC[1],1,)),)"
    Range("d3:d" & ba) = Range("d3:d" & ba).Value
    Range("d" & ba + 1) = Application.Count(Range("d3:d" & ba))
    Range("f" & ba + 1 & ":i" & ba + 1).FormulaR1C1 = "=SUM(R3C:R[-1]C)"
    Range("f" & ba + 1 & ":i" & ba + 1) = Range("f" & ba + 1 & ":i" & ba + 1).Value
End Sub