使用条件触发器将多行从一个表移动到另一个表

Question

我构建了一个包含多个表格的工作簿，每个表格都在自己的工作表上。
该工作簿的目的是帮助跟踪患者线路。

当为患者放置新线路时，工作人员将使用 MS Forms/Power Automate 流程将该线路添加到表中。
那时，表列“状态”将被标记为“维护中”。
此外，该行将包含患者的唯一 ID 和当前单位。

如果患者转移到其他科室，将添加一个包含更新信息的新行。
原始行的“状态”列将更改为“已转移”，但仍保留在表中以供跟踪。
根据患者的住院情况，此过程可能会通过多次转移继续进行，因此需要保持动态。

当准备好拉线时，“状态”栏将标记为“已停止”。
这应该会触发 VBA 代码来查找具有匹配唯一 ID 的所有行，并将它们全部移动到存档表中，然后从活动行表中删除它们。

总结：
我希望根据共享的“唯一 ID”移动多行，并在包含该唯一 ID“状态”列的行之一更改为“已停止”时触发流程。

我构建了 VBA 代码，该代码将根据触发器移动一行。
我找不到一种方法来引用被触发的行的唯一 ID，以获取包含唯一 ID 的所有匹配行。

供参考：
活动行表名称：“CVL”
活动行表名称：“CVL”

归档行表名称：“Archived_CVL”
存档的行表名称：“Archived_CVL”

状态列名称：“状态”标题位置 I3，数据范围：I4:I
唯一 ID 列名称：“唯一 ID”标题位置 A3，数据范围 A4:A

活动表和存档表具有相同的列标题和相同的行/列位置。 （本质上，这些表格是彼此的复制/粘贴。）

主动 CVL 表

已存档的 CVL 表

表中的所有信息均为示例数据，并非实际患者信息。

Answer 1

• 右键单击工作表 (CVL) 选项卡 > 查看代码 > 粘贴代码

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sID As String, oTab As ListObject, rngVis As Range
    Const KEYWORD = "Discontinued"
    Const UID = "Unique ID"
    Const DEST_SHT = "Archived_CVL"
    With Target
        If .CountLarge = 1 Then
            If .Column = 9 And .Row > 3 Then
                If (Not .ListObject Is Nothing) And StrComp(KEYWORD, .Value, vbTextCompare) = 0 Then
                    Set oTab = .ListObject
                    sID = Me.Cells(.Row, 1).Value
                    'Debug.Print sID
                    If oTab.AutoFilter.FilterMode Then oTab.AutoFilter.ShowAllData
                    oTab.Range.AutoFilter Field:=1, Criteria1:=sID
                    On Error Resume Next
                    Set rngVis = oTab.DataBodyRange.SpecialCells(xlCellTypeVisible)
                    On Error GoTo 0
                    If Not rngVis Is Nothing Then
                        With Sheets(DEST_SHT)
                            rngVis.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
                        End With
                        Application.EnableEvents = False
                        oTab.AutoFilter.ShowAllData
                        rngVis.Delete
                        Application.EnableEvents = True
                    End If
                End If
            End If
        End If
    End With
End Sub