excel - 如何通过excel VBA返回满足设定条件的特定行

Question

我有这些数据，我正在跟踪缺陷代码的连续和多次出现。
连续缺陷代码是在同一区域和同一行下连续出现的缺陷代码。多个是在同一区域和同一行下
出现 3 次或更多（即使不连续）的缺陷代码。

区域线 批号 日期 代码 描述
总成 Line1 LOT000000001 10/3/2013 13:31 5c 振动失败
总成 Line12 LOT000000002 10/3/2013 13:25 5g 按键故障
Labl Line2 LOT000000003 10/3/2013 13:08 5a 不收费
骰子线 1 LOT000000004 10/3/2013 13:03 5b 系统故障
骰子线 2 LOT000000005 2013 年 10 月 3 日 13:09 3j 软件失败
骰子 Line3 LOT000000006 10/3/2013 13:29 5d 无显示
Circ Line1 LOT000000007 10/3/2013 13:25 3n 短
Circ Line1 LOT000000008 10/3/2013 13:38 3n 短
Circ Line10 LOT000000009 10/3/2013 13:26 3n 短
Circ Line12 LOT000000010 10/3/2013 13:30 3n 短
Circ Line2 LOT000000011 10/3/2013 13:02 3n 短
Circ Line3 LOT000000012 10/3/2013 13:15 3n 短
Circ Line7 LOT000000013 10/3/2013 13:24 3n 短
Circ LineA LOT000000014 10/3/2013 13:10 3o 打开
Circ LineA LOT000000015 10/3/2013 13:14 3n 短
Circ LineA LOT000000016 10/3/2013 13:46 3c 高分辨率
Circ LineA LOT000000017 10/3/2013 13:47 3n 短
Circ LineA LOT000000018 10/3/2013 13:50 3o 打开
Circ LineA LOT000000019 10/3/2013 13:51 3n 短
Circ LineA LOT000000020 10/3/2013 13:55 3b 低分辨率
OSTS Line1 LOT000000021 10/3/2013 13:48 3b 低分辨率
OSTS Line1 LOT000000022 10/3/2013 13:50 3f 无痕迹
OSTS Line11 LOT000000023 10/3/2013 13:06 3a 无信号
OSTS Line2 LOT000000024 10/3/2013 13:24 3a 无信号

在这种情况下，我的预期结果是：

Circ Line1 LOT000000007 10/3/2013 13:25 3n 短
Circ Line1 LOT000000008 10/3/2013 13:38 3n 短

为连续发生。

这对于多次出现。

Circ LineA LOT000000015 10/3/2013 13:14 3n 短
Circ LineA LOT000000017 10/3/2013 13:47 3n 短
Circ LineA LOT000000019 10/3/2013 13:51 3n 短

所以原始数据在 Sheet1 上，我希望在 Sheet2 中使用相同的标题传输结果。
我所做的是将原始数据传递到一个数组中，然后遍历它。
我没有得到我想要的。代码很长，懒得贴了。

而且我认为制作新代码比调试我的代码更容易。
任何帮助都感激不尽。提前致谢。
如果您仍有疑问，请直接将其关闭。

Answer 1

公式输入I2==A2&B2&G2
公式输入J2==COUNTIF($I$2:$I$25,I2)
公式输入K2==I2=I3
公式输入L2==IF(OR(K2,J2>=3,K1),"Copy","Do not copy")

过滤数据column L并复制到所需的工作表。

Answer 2

我也赞成为此使用公式，并且我在您帖子的评论中给出的屏幕截图是使用公式得出的。但是，既然您想要一个 VBA 代码，就在这里。

假设，您的工作表如下所示

逻辑：

1. 查找 Sheet1 的最后一行
2. =A2&B2&D2&F2在 Col H 中插入公式
3. =IF(H2=H3,"YES",IF(H2=H1,"YES",""))在 Col I 中插入公式

4. =IF(AND(I2="",COUNTIF(H:H,H2)>2),"YES" & H2,"")在 Col J 中插入公式

   • 实现这一目标的目标

   

5. 下一步创建 2 张用于输出。让我们将连续记录输出到Consecutive工作表，将多条记录输出到工作Multiple表

6. 过滤Col IforYes并将它们移动到工作Consecutive表
7. 过滤Col JforNon Blanks并将它们移动到工作Multiple表
8. Multiple根据 Col J 对工作表中的数据进行排序
9. H:J从所有工作表中删除列

代码：

Option Explicit

Sub Sample()
    Dim ws As Worksheet, wsConsc As Worksheet, wsMulti As Worksheet
    Dim lRow As Long

    '~~> Change this to the releavnt sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    '~~> To create Consecutive and Multi sheets, delete existing ones if appl
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets("Consecutive").Delete
    ThisWorkbook.Sheets("Multi").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    '~~> Create new sheets for output
    Set wsConsc = ThisWorkbook.Sheets.Add: wsConsc.Name = "Consecutive"
    Set wsMulti = ThisWorkbook.Sheets.Add: wsMulti.Name = "Multi"

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        .Columns("H:J").ClearContents

        .Range("H2:H" & lRow).Formula = "=A2&B2&D2&F2"
        .Range("I2:I" & lRow).Formula = "=IF(H2=H3,""YES"",IF(H2=H1,""YES"",""""))"
        .Range("J2:J" & lRow).Formula = "=IF(AND(I2="""",COUNTIF(H:H,H2)>2),""YES"" & H2,"""")"

        .Range("H2:J" & lRow).Value = .Range("H2:J" & lRow).Value

        .AutoFilterMode = False

        With .Range("I1:I" & lRow)
            .AutoFilter Field:=1, Criteria1:="=YES"
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            wsConsc.Rows(1)
        End With

        .AutoFilterMode = False

        With .Range("J1:J" & lRow)
            .AutoFilter Field:=1, Criteria1:="<>"
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            wsMulti.Rows(1)

            wsMulti.Columns("A:J").Sort Key1:=wsMulti.Range("J2"), Order1:=xlAscending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        End With

        .AutoFilterMode = False

        .Columns("H:J").ClearContents
        wsConsc.Columns("H:J").ClearContents
        wsMulti.Columns("H:J").ClearContents
    End With
End Sub

输出：