Формулу Excel прописать макросом в VBA

[FiataliS]

Здравствуйте, прошу помощи)
Есть формула: она прописана в каждой ячейке дипазона i с соответствующем номером строки. Например:

=ЕСЛИ(D30>"";H30+ДЕНЬ(AE30)-AF30;"")

С условием заполнения диапазона ячеек D, то при ее заполнении считать формулу

H30+ДЕНЬ(AE30)-AF30

иначе оставить ее пустой.

Проблема в том что на эту ячейку у меня прописан еще макрос который удаляет формулу при иполеннии другова условия.

Private Sub Worksheet_Change(ByVal Target As Range)
     If Target.Cells.Count > 1 Then Exit Sub
         If Not Intersect(Target, Range("g2:g1000")) Is Nothing Then
              With Target(1, 3 )
                         .Value = Now
                  .EntireColumn.AutoFit
             End With
       End If
........
..... . .

Где 3 столбец от G и есть D.
И как бы небыло проблем бы, но при дальнейшем очищении диапазона ячеек D формула назад не вставляеться и ее приходится копировать из соседней ячейки.
Как бы мне автаматизировать данную процидуру или прописать формулу в VBA согластно условиям?

[EducatedFool]

во-первых, чтобы ваш макрос изменял ячейки в столбце D,
должно быть написано не With Target(1, 3),
а With Target(1, -3)

Макрос записи формулы в активную ячейку:

 ActiveCell.FormulaR1C1 = "=IF(RC4>"""",RC8+DAY(RC31)-RC32,"""")"

в вашем случае:

If Not Intersect(Target, Range("g2:g1000")) Is Nothing Then
              With Target(1, -3)
                         .FormulaR1C1 = "=IF(RC4>"""",RC8+DAY(RC31)-RC32,"""")"
                  .EntireColumn.AutoFit
             End With
       End If

[FiataliS]

Спасибо все четко работает.
Вы наверно меня не правильно поняли, но в общем я ее немного подправил относительно своих сталбцов.

И получилось что при очищении ячейки в столбце D формула вставлялась в столбец i , который являеться 6-тым от D и с ним включительно.

 If Not Intersect(Target, Range("d2:d1000")) Is Nothing Then
              With Target(1, 6)
                         .FormulaR1C1 = "=IF(RC4>"""",RC8+DAY(RC31)-RC32,"""")"
                  .EntireColumn.AutoFit
             End With
       End If

А как бы можно было добавить в данный макрос при том же условии, но чтобы в соседнем столбце слева все стиралось?

Как мне показалось могло бы все заработать с такого продолжения:

If Not Intersect(Target, Range("d2:d1000")) Is Nothing Then
              With Target(1, 5)
                         .Value = ""
                  .EntireColumn.AutoFit
             End With
       End If

Но нет, почему то оно чистит ячейку и при заполнении и опустошении.

Все равно вы мне уже очень помогли. Спасибо за помощь.

[FiataliS]

Сообщение от FiataliS

Спасибо все четко работает.
Вы наверно меня не правильно поняли, но в общем я ее немного подправил относительно своих сталбцов.

И получилось что при очищении ячейки в столбце D формула вставлялась в столбец i , который являеться 6-тым от D и с ним включительно.

 If Not Intersect(Target, Range("d2:d1000")) Is Nothing Then
              With Target(1, 6)
                         .FormulaR1C1 = "=IF(RC4>"""",RC8+DAY(RC31)-RC32,"""")"
                  .EntireColumn.AutoFit
             End With
       End If

А как бы можно было добавить в данный макрос при том же условии, но чтобы в соседнем столбце слева все стиралось?

Как мне показалось могло бы все заработать с такого продолжения:

If Not Intersect(Target, Range("d2:d1000")) Is Nothing Then
              With Target(1, 5)
                         .Value = ""
                  .EntireColumn.AutoFit
             End With
       End If

Но нет, почему то оно чистит ячейку и при заполнении и опустошении.

Все равно вы мне уже очень помогли. Спасибо за помощь.

Все и с этим вапросом уже разобрался, спасибо за данное направление кода.

Вот весь результат

 Private Sub Worksheet_Change(ByVal Target As Range)
     If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("g2:g1000")) Is Nothing Then
            With Target(1, 3)
                .Value = Now
                .EntireColumn.AutoFit
                End With
          
          
          End If
    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("D2:D1000")) Is Nothing Then
            With Target(1, 5)
                .Value = Now
                .EntireColumn.AutoFit
            End With
        End If
       
        
       Dim R As Range
    If Not Intersect(Target, Me.Columns(7)) Is Nothing Then
        If Intersect(Target, Me.Columns(7)).Cells.Count < 10 Then
            For Each R In Intersect(Target, Me.Columns(7))
                If Not IsEmpty(R.Value) Then
                    Range("a" & Target.Row & ":j" & Target.Row).Interior.Color = RGB(130, 250, 100)
                End If
            Next
        End If
    End If
        
        If Not Intersect(Target, Me.Columns(7)) Is Nothing Then
        If Intersect(Target, Me.Columns(7)).Cells.Count < 10 Then
            For Each R In Intersect(Target, Me.Columns(7))
                If IsEmpty(R.Value) Then
                    Range("a" & Target.Row & ":j" & Target.Row).Interior.Color = RGB(216, 216, 216)
                End If
            Next
        End If
    End If
    
       If Not Intersect(Target, Range("c2:c1000")) Is Nothing Then
              With Target(1, 6)
                         .Value = ""
                  .EntireColumn.AutoFit
             End With
       End If
       
      If Not Intersect(Target, Range("d2:d1000")) Is Nothing Then
              With Target(1, 6)
                         .FormulaR1C1 = "=IF(RC4>"""",RC8+DAY(RC31)-RC32,"""")"
                  .EntireColumn.AutoFit
             End With
       End If



            
End Sub

А ошибка была в том что он чистил ячейку и пытался вставить в нее адновременно. А так как очистка была на 2 месте то она оставалась пустой. Если я правильно понял.
Однако работает.
Спасибо