Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 10000 Then Exit Sub
    Dim rng As Range
    Set rng = Range("Таблица1[Столбец4]")
    If rng Is Nothing Then Exit Sub
    
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False: .EnableEvents = False
        
        If Not Intersect(Target, [c1]) Is Nothing And Target.Count = 1 Then
            Dim arr, li&, lmp#
            .Undo: lmp = [c1]: .Undo
            arr = rng.Value
            For li = 1 To UBound(arr)
                If Not IsEmpty(arr(li, 1)) And IsNumeric(arr(li, 1)) Then arr(li, 1) = arr(li, 1) / (1 + lmp) * (1 + [c1])
            Next li
            rng.Value = arr
        End If
        
        If Not Intersect(Target, rng) Is Nothing Then
            If Not IsEmpty(Target) Then Target.Value = Evaluate(Target.Address & "*" & Replace(CStr(1 + [c1]), ",", "."))
        End If
        
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True: .EnableEvents = True
    End With
    
End Sub