根据 Excel 中的条件在另一个选项卡上生成列表

Question

我正在寻找一种从表条目中生成表的方法。

我已经找到了几乎满足我的需求的解决方案但我需要它更“动态”，我希望如果我在第一个表上添加一行，它将自动添加到第二个页面。

这里有一个链接到我的 OneDrive 共享文件也许有人可以帮我解决这个问题？

Answer 1

我不喜欢函数。这里，取一个宏（你将其标记为 VBA）：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, inputRange As Range
    Set inputRange = ActiveSheet.Range("A:D")   'Code only executes when a change occurs within this range

    If Not Application.Intersect(Range(Target.Address), inputRange) Is Nothing Then
        Set ws1 = Worksheets(2) 'Can also be written Worksheets("Brand X")
        Set ws2 = Worksheets(3) 'Can also be written Worksheets("Brand Y")
        Set ws3 = Worksheets(4) 'Can also be written Worksheets("Brand Z")
        Call splitList("X", ws1)  'The string to search for always in UPPERCASE.
        Call splitList("Y", ws2)
        Call splitList("Z", ws3)
    End If

End Sub
Private Sub splitList(ByVal brand As String, outSheet As Worksheet)
    Dim entry As Range, oCN As Long, i As Long, brandCol As String, searchRange As Range

    brandCol = "C"                              'Column where brand name is located
    oCN = Columns(brandCol).Column
    Set searchRange = ActiveSheet.Range(brandCol & "2:" & brandCol & ActiveSheet.Cells(Rows.Count, oCN).End(xlUp).Row)    'Where to look for Brand name
    outSheet.Range(brandCol & "2:" & brandCol & outSheet.Cells(Rows.Count, oCN).End(xlUp).Offset(1, 0).Row).EntireRow.Value = ""    'Clear old list
    For Each entry In searchRange
        If UCase(entry.Value) = brand Then
            outSheet.Range(brandCol & outSheet.Cells(Rows.Count, oCN).End(xlUp).Offset(1, 0).Row).EntireRow.Value = entry.EntireRow.Value   'Write new list
        End If
    Next entry
End Sub

在 excel 中，右键单击第一个 (产品) 选项卡并选择“显示代码”。粘贴代码，即可完成。

实际操作：