Есть ли способ, как отменить код для добавления новой строки

Question

У меня есть код ниже, который в простой форме запроса дает запрашивающей стороне возможность добавить строку для того же пользователя.

Если в раскрывающемся меню выбрано «Да», новая строка заполняется тем же именем и псевдонимом, которые использовались в предыдущей строке, тогда как другие строки под ним будут соответственно перемещаться вниз на одну строку.

Код для добавления новой строки (работает нормально) выглядит следующим образом:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim LastRow As Long

With ThisWorkbook.Worksheets("AWS Applications")

    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    If Not Intersect(Target, .Range("F7:F" & LastRow)) Is Nothing And Target.Value = "Yes" Then
        Application.EnableEvents = False
            .Rows(Target.Row + 1).EntireRow.Insert
            .Range("A" & Target.Row & ":C" & Target.Row).Copy .Range("A" & Target.Row + 1 & ":C" & Target.Row + 1)
        Application.EnableEvents = True
    End If

End With

End Sub

Я изменил приведенный выше код следующим образом, поэтому он удаляет строку ниже, если выбрана опция «Нет». И это работает правильно:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim LastRow As Long

With ThisWorkbook.Worksheets("AWS Applications")

    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    If Not Intersect(Target, .Range("F7:F" & LastRow)) Is Nothing And Target.Value = "Yes" Then
        Application.EnableEvents = False
            .Rows(Target.Row + 1).EntireRow.Insert
            .Range("A" & Target.Row & ":C" & Target.Row).Copy .Range("A" & Target.Row + 1 & ":C" & Target.Row + 1)
        Application.EnableEvents = True
    End If

    If Not Intersect(Target, .Range("F7:F" & LastRow)) Is Nothing And Target.Value = "No" Then
        Application.EnableEvents = False
            .Rows(Target.Row + 1).EntireRow.Delete
        Application.EnableEvents = True
    End If


End With

End Sub

Однако я хочу убедиться, что нижняя строка удаляется после выбора «Нет», только в тех случаях, когда нижняя строка, которая должна быть удалена, содержит те же данные, что и строка выше. Как и сейчас, в любом случае он удаляет приведенную ниже строку, т. Е. Даже если запрашивающая сторона ранее не нажимала «Да», и это нежелательный результат.

Я пытался изменить условие «Нет» следующим образом, но все еще пытался:

If Not Intersect(Target, .Range("F7:F" & LastRow)) Is Nothing And Target.Value = "No" Then
        If Range("A" & Target.Row & ":C" & Target.Row).Value = Range("A" & Target.Row + 1 & ":C" & Target.Row + 1).Value Then
        Application.EnableEvents = False
            .Rows(Target.Row + 1).EntireRow.Delete
        Application.EnableEvents = True
        End If
End If

Не могли бы вы помочь?

FOLLOW-UP: Код, который у меня сейчас есть, таков:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim LastRow As Long

With ThisWorkbook.Worksheets("AWS Applications")

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

If Not Intersect(Target, .Range("F7:F" & LastRow)) Is Nothing And Target.Value = "Yes" Then
    Application.EnableEvents = False
        .Rows(Target.Row + 1).EntireRow.Insert
        .Range("A" & Target.Row & ":C" & Target.Row).Copy .Range("A" & 
Target.Row + 1 & ":C" & Target.Row + 1)
    Application.EnableEvents = True
End If



If Not Intersect(Target, .Range("F7:F" & LastRow)) Is Nothing And Target.Value = "No" Then

    AllOk = True
    For Each xCel In UpperRow.Cells
        If AllOk And (xCel.Value <> xCel.Offset(1, 0).Value) Then
            AllOk = False
        End If
    Next xCel
    If AllOk Then
    Application.EnableEvents = False
        .Rows(Target.Row + 1).EntireRow.Delete
    Application.EnableEvents = True
    End If

End If

End With
End Sub

Я получаю сообщение об ошибке «424» «Требуется объект», и отладка выделяет это: For Each xCel In UpperRow.Cells

Не могли бы вы помочь? Извиняюсь, я новичок в этом ...

Answer 1

в качестве ориентировочного ответа

AllOk = True
for each xCel in UpperRow.Cells
   if AllOk and (xCel.Value <> xCel.Offset(1,0).Value) then
      AllOk = False
   End If
Next xCel
IF AllOk then
   ' Delete the Row
End If

Вам нужно будет заполнить некоторые детали и, возможно, некоторую проверку ошибок - не полный ответ