如果在 Excel 中满足值，则复制部分行

Question

我有一个 Excelsheet 看起来类似于此 (Sheet1):

我想要的是对于 J 列包含的所有行（动态的）NEW-LOCATION 我想从 A、C 列复制这些行的信息, D 和 E 到另一个 sheet (Sheet2) 但我也可以在新 sheet 上添加新信息，如下所示：

绿色部分是从Sheet1复制过来的，黄色部分是我自己在Sheet2中写的。它应该是动态的，如果在 Sheet1 中删除值 NEW-LOCATION，则应删除 sheet2 中包含信息的行。

有人知道如何管理吗？它不一定是代码，它可以是公式、条件格式或任何其他可以管理它的默认 Excel 东西。

Answer 1

请在实际数据上使用之前测试它，我可能忽略了一些东西。
到目前为止我想出了什么，为了清楚起见，我注释了部分代码，请注意它是 Sheet1 的 Sub Worksheet_Change 模块，相应地粘贴它：

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Main As Worksheet, Secondary As Worksheet
    Dim iCell As Range, FoundRange As Range
    Dim lRow As Long

    '   Define worksheets for simplicity
    With ThisWorkbook
        Set Main = .Worksheets("Sheet1")
        Set Secondary = .Worksheets("Sheet2")
    End With

    '   Calculate last row on Sheet2 (by column "A")
    lRow = Secondary.Range("A" & Secondary.Rows.Count).End(xlUp).Row

    '   Check if changes were made in columns "J" (Information)
    '   If changes weren't made in column "J" leave this sub
    If Intersect(Target, Main.Columns("J")) Is Nothing Then Exit Sub

    '   Loop through each changed cell of column "J"
    For Each iCell In Intersect(Target, Main.Columns("J")).Cells
        '   Find location on Sheet2
        'Main.Range("A" & iCell.Row).Value
        Set FoundRange = Secondary.Range("A2:A" & lRow).Find(Main.Range("A" & iCell.Row).Value, , xlValues, xlWhole)
        '   If value of the changed cell is "NEW-LOCATION"..
        If iCell.Value = "NEW-LOCATION" Then
            '   And it didn't find this location on Sheet2..
            If FoundRange Is Nothing Then
                '   Add new location
                Secondary.Range("A" & lRow + 1).Value = Main.Range("A" & iCell.Row).Value
                Secondary.Range("B" & lRow + 1 & ":D" & lRow + 1 & "").Value = Main.Range("C" & iCell.Row & ":E" & iCell.Row & "").Value
                lRow = lRow + 1
            End If
        '   If value of the changed cell is NOT "NEW-LOCATION"..
        Else
            '   And it found this location in Sheet2..
            If Not FoundRange Is Nothing Then
                '   Delete row with this location
                FoundRange.EntireRow.Delete
                lRow = lRow - 1
            End If
        End If
    Next
End Sub

如果在 Excel 中满足值，则复制部分行

Copy part of row if value is met in Excel

excel

vba

conditional-formatting

excel-formula