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

能请你帮忙吗？

跟进：我现在拥有的代码是：

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

您需要填写一些详细信息，也许还需要进行一些错误检查-并非完整的答案

有没有一种方法可以反向添加新行的代码

1 个答案: