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

Question

这是我遇到的问题，我构建了一个包含多个表格的工作簿，每个表格都在自己的工作表上。该工作簿的目的也是帮助跟踪患者线路。该表的功能是，当对患者放置新线路时，工作人员将使用 MS Forms/Power Automate 流程将该线路添加到表中。届时，表列“状态”将被标记为“维护中”，此外，该行将包含患者的唯一 ID 和当前单位。如果患者转移到其他科室，则会添加一个包含更新信息的新行。原始行的“状态”列将更改为“已转移”，但仍保留在表中以用于跟踪目的。根据患者的住院情况，这一过程可能会通过多次转移继续进行，因此需要保持动态。当该行最终准备好被拉取时，“状态”列将被标记为“已停止”，然后触发 VBA 查找具有匹配唯一 ID 的所有行，并将它们全部移动到存档表中，然后将其删除从活动线路表中。

总而言之：我希望制作一个 VBA，它将根据共享的“唯一 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