在Excel中，如何有条件地剪切一行数据并将其永久移动到另一个工作表？

Question

我有一个工作表，其中列出了我所有的项目。当我从 D 列的下拉列表中将一行（项目）标记为 "Finaled" 时，我希望将整行移动到我的 "Finaled" 工作表并永久保留在该工作表上。

我有基本的编程知识，想出了这个宏...

    Sub Finaled()
    Dim i, LastRow

    Sheets("FINALED").Range("A2:Z500").ClearContents
    For i = 19 To LastRow
    If Sheets("ACTIVE").Cells(i, "D").Value = "Finaled" Then
    Sheets("ACTIVE").Cells(i, "D").EntireRow.Copy Destination:=Sheets("FINALED").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
    Next i
    End Sub

...但这并不完全像我想要的那样工作。第一个问题是它只复制信息行，当我从主工作表中手动删除该行时，下次我运行宏时，我丢失了最终工作表上最初复制的数据行。我希望它完全剪切数据行并将其移动到我的 "Finaled" 工作表，并永久保留在那里。

其次，一旦我从 D 列的下拉列表中将该行标记为 "finaled"，此移动是否会自动发生？还是我每次都必须手动运行宏？

Answer 1

在 VBA 编辑器中，双击您名为 ACTIVE 的作品sheet，这将调出该作品sheet 的代码模块（并不是说它是不同于标准模块）：

然后在 sheet 模块中，粘贴以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim wsData As Worksheet
    Dim wsDest As Worksheet
    Dim rngCheck As Range
    Dim rngChanged As Range
    Dim ChangedCell As Range
    Dim rngMove As Range

    Set wsData = Me
    Set wsDest = Me.Parent.Sheets("FINALED")
    Set rngCheck = wsData.Range("D19", wsData.Cells(wsData.Rows.Count, "D").End(xlUp))
    If rngCheck.Row < 19 Then Exit Sub  'No data

    Application.EnableEvents = False
    On Error GoTo ReEnableEvents

    Set rngChanged = Intersect(rngCheck, Target)

    If Not rngChanged Is Nothing Then
        For Each ChangedCell In rngChanged.Cells
            If LCase(Trim(ChangedCell.Value)) = "finaled" Then
                Select Case (rngMove Is Nothing)
                    Case True:  Set rngMove = ChangedCell
                    Case Else:  Set rngMove = Union(rngMove, ChangedCell)
                End Select
            End If
        Next ChangedCell

        If Not rngMove Is Nothing Then
            With rngMove.EntireRow
                .Copy
                wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
                .Delete xlShiftUp
            End With
        End If
    End If

ReEnableEvents:
    Application.EnableEvents = True
End Sub

现在，当您将 D 列中的单元格更改为 "finaled" 时，它将自动移至 FINALED 工作sheet。

此外，您丢失 FINALED 作品 sheet 数据的原因是因为这一行：Sheets("FINALED").Range("A2:Z500").ClearContents 我没有包括在内，因为我不认为你真的想要那个。

在Excel中，如何有条件地剪切一行数据并将其永久移动到另一个工作表？

In Excel, how can I conditionally cut a row of data and move it to another worksheet permanantly?

excel

vba

conditional-formatting

worksheet-function