Question

Sheet1被称为Action Items，Sheet2被称为Completed Items。

J中的Completed Items列包含在下拉列表中排序的值。只要将值设置为O，P或D，就应按以下方式将此行重新定位到Action Items：

请注意，列A包含两个表格中从行5到行1005的ID号。
假设标识1位于5行，1列Completed Items，标识2位于5行，列1的{{1}}。
如果我现在将Action Items中的J5设置为Completed Items，O或P，我希望VBA代码在{{中插入新行1}}并按以下方式从D填充该行与相应行的内容：
1. 将当前Action Items行Completed Items重新定位到行Action Items，将行5重新定位到行6，等等。也就是说，在那里插入一个空行（唯一）ID 小于，而不是下面行中的ID，因此在给定的示例中，它将是行6中的ID 7和ID 1然后在5行等等
2. 然后，从2删除修改后的行。

即：所有代码正在进行的是将一行从一个工作表重新定位到另一个工作表。但是，我当前的代码仍会导致一些问题（6 = Completed Items和Zeile2 = Row2）：

Zeile1

此代码不能

在中插入我想要的空行

和
无法将该行重新定位到它的位置。

我尝试更改某些数字，甚至尝试使用Row1选项处理Private Sub Worksheet_Change(ByVal Target As Range) Dim Zeile2, Zeile1 As Long Set Target = Intersect(Target, Range("J5:J1005")) If Target Is Nothing Then Exit Sub If Target = "O" Or Target = "P" Or Target = "D" Then Zeile2 = Target.Row Zeile1 = 5 Do While Cells(Zeile2, 1) >= Sheets("Action Items").Cells(Zeile1, 1) Zeile1 = Zeile1 + 1 Loop Sheets("Action Items").Cells(Zeile1, 1).EntireRow.Insert Range(Cells(Zeile2, 1), Cells(Zeile2, 14)).Copy _ Destination:=Sheets("Action Items").Cells(Zeile1, 1).End(xlUp) Target.EntireRow.Delete End If End Sub的代码（然后类似.End(xlUp)），但没有任何效果到目前为止。

我做错了什么？

（很遗憾，我无法与您共享Excel文件，因为这是商业机密。）

Answer 1

<强>替换

If Target = "O" Or Target = "P" Or Target = "D" Then
        Zeile2 = Target.Row
        Zeile1 = 5
        Do While Cells(Zeile2, 1) >= Sheets("Action Items").Cells(Zeile1, 1)
            Zeile1 = Zeile1 + 1
        Loop
        Sheets("Action Items").Cells(Zeile1, 1).EntireRow.Insert
        Range(Cells(Zeile2, 1), Cells(Zeile2, 14)).Copy _
        Destination:=Sheets("Action Items").Cells(Zeile1, 1).End(xlUp)
        Target.EntireRow.Delete
    End If

<强>与

If Target = "O" Or Target = "P" Or Target = "D" Then
Application.EnableEvents = False
        Zeile2 = Target.Row
        Zeile1 = 5
        Do While Cells(Zeile2, 1) >= Sheets("Action Items").Cells(Zeile1, 1)
            Zeile1 = Zeile1 + 1
        Loop
        Sheets("Action Items").Cells(Zeile1, 1).EntireRow.Insert
        Range(Cells(Zeile2, 1), Cells(Zeile2, 14)).Copy _
        Destination:=Sheets("Action Items").Cells(Zeile1, 1).End(xlUp)
        Target.EntireRow.Delete
Application.EnableEvents = True
End If

可能还有其他问题。

Answer 2

我终于弄明白了错误是什么！

删除.End(xlUp)为我做了一件事，产生了以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Zeile2, Zeile1 As Long
    Set Target = Intersect(Target, Range("J5:J1005"))
    If Target Is Nothing Then Exit Sub
    If Target = "O" Or Target = "P" Or Target = "D" Then
        Zeile2 = Target.Row
        Zeile1 = 5
        Do While Cells(Zeile2, 1) >= Sheets("Action Items").Cells(Zeile1, 1)
            Zeile1 = Zeile1 + 1
        Loop
        Sheets("Action Items").Cells(Zeile1, 1).EntireRow.Insert
        Range(Cells(Zeile2, 1), Cells(Zeile2, 14)).Copy _
        Destination:=Sheets("Action Items").Cells(Zeile1, 1)
        Target.EntireRow.Delete
    End If
End Sub

Excel VBA：“Worksheet_Change”函数使用“.EntireRow.Insert”并且无法正确处理

2 个答案: