Форум по VBA и MS Office

Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Variant
  If Target.Address = "$R$10" Then
    If ActiveSheet.Range("$R$10") <> "" Then
      A = ActiveSheet.Range("$Q$10")
      ActiveSheet.Range("$Q$10") = A
      Else
      ActiveSheet.Range("$Q$10").FormulaR1C1 = "=IF(RC[-8]="""",IF((RC[-11]-RC[-12])<182,DATE(YEAR(RC[-12]),MONTH(RC[-12])+3,DAY(RC[-12])),DATE(YEAR(RC[-12]),MONTH(RC[-12])+6,DAY(RC[-12]))),IF((RC[-11]-RC[-12])>182,DATE(YEAR(RC[-11]),MONTH(RC[-11])-2,DAY(RC[-11])-10),DATE(YEAR(RC[-11]),MONTH(RC[-11])-5,DAY(RC[-11])-10)))"
      End If
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    ' Если изменения произошли в нескольких ячейках, то ничего не делаем,
        ' т.к. тяжело предсказать, что нужно сделать, и нужно делать более сложный код.
    If Target.Cells.CountLarge <> 1 Then Exit Sub
    ' Если изменение не произошло в столбце R.
    If Target.Column <> 18 Then Exit Sub
   
    ' Отключение событий, чтобы эта процедура не запускала сама себя.
    Application.EnableEvents = False
   
    ' Если в столбце R ячейка не пустая, то замена формулы в столбце Q на значение.
    If Target.Value <> "" Then
        With Target.EntireRow.Columns("Q")
            .Value = .Value
        End With
    ' Если в столбце R ячейка пустая, вставка формулы в столбец Q.
    Else
        Target.EntireRow.Columns("Q").FormulaR1C1 = "=IF(RC[-8]="""",IF((RC[-11]-RC[-12])<182,DATE(YEAR(RC[-12]),MONTH(RC[-12])+3,DAY(RC[-12])),DATE(YEAR(RC[-12]),MONTH(RC[-12])+6,DAY(RC[-12]))),IF((RC[-11]-RC[-12])>182,DATE(YEAR(RC[-11]),MONTH(RC[-11])-2,DAY(RC[-11])-10),DATE(YEAR(RC[-11]),MONTH(RC[-11])-5,DAY(RC[-11])-10)))"
    End If
   
    ' Включение событий.
    Application.EnableEvents = True

End Sub