时间戳

首页 > 解决方案 > 根据仅一行中的条件将多行复制到新工作表

excel - 根据仅一行中的条件将多行复制到新工作表

问题描述

我的数据集是这样的：A 列 = ID 号，B 列 = 测试类型，C 列 = 结果。

A 列中的每个 ID 出现多次。对于每次出现，都有一个结果为“是”或“否”的测试。

如果给定 ID 的一个测试结果返回“是”，我想将该 ID 的所有行复制到同一工作簿中的新工作表中。

所以在我附上的照片中：ID 1234，蓝色测试类型返回“是”，而粉色测试类型返回“否”。我想将 ID 1234 的两行复制到新工作表，因为一个或多个测试（蓝色或粉红色）返回“是”。ID 4321 应该保持不变，因为两个测试都是“否”。

我不知道如何开始，我敢肯定可能涉及“如果，那么”语句。

任何建议如何在 VBA 中解决这个问题？

带有 ID、测试类型和结果的工作表：一个示例，但会有大约 1000 多行数据。

标签： excelvba

解决方案

这个可以吗 ？

Sub filter_and_copy()

    ' Variables
    Dim oWsFrom As Worksheet
    Dim oWsTo As Worksheet
    Dim oRangeData As Range
    Dim nbRow As Long
    
    ' Settings
    Set oWsFrom = ThisWorkbook.Worksheets("sheet1")
    Set oWsTo = ThisWorkbook.Worksheets("sheet2")
    oWsTo.Cells.ClearContents
    Set oRangeData = oWsFrom.Cells(1, 1).CurrentRegion
    nbRow = oRangeData.Rows.Count
    
    ' Formula and filter
    With oWsFrom
        .Cells(1, 4).Value = "Formula"
        .Cells(2, 4).Formula = "=COUNTIFS(A:A,A2,C:C,""yes"")"
        .Cells(2, 4).AutoFill Destination:=.Range(.Cells(2, 4), .Cells(nbRow, 4))
        .AutoFilterMode = False
        .Rows(1).AutoFilter Field:=4, Criteria1:="1"
    End With
    
    ' Copy
    oWsFrom.Range(Columns(1), Columns(3)).SpecialCells(xlCellTypeVisible).Copy oWsTo.Cells(1, 1)

End Sub

推荐阅读