如何通过Excel VBA返回符合设置标准的特定行

我有这个数据，我跟踪连续和多次出现的缺陷代码。
连续的缺陷代码是连续出现在同一区域和行下的代码。
多出现3次以上的缺陷代码（即使不是连续的）
在相同的面积和线下。

区域批号date代码说明
总成线1 LOT000000001 10/3/2013 13:31 5c振动失败
 Assy Line12 LOT000000002 10/3/2013 13:25 5g重要故障
 Labl Line2 LOT000000003 10/3/2013 13:08 5a免费
 Dice Line1 LOT000000004 10/3/2013 13:03 5b系统失败
骰子线2 LOT000000005 10/3/2013 13:09 3j Sofwware失败
骰子行3 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行1 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中使用相同的头文件传输结果。
我所做的是将原始数据传递给一个数组，然后遍历它。
虽然我没有得到我想要的。 代码很长，所以我没有打扰发布。

我认为编写新代码比debugging我的代码更容易。
任何帮助都感激不尽。 提前致谢。
如果你还有问题，就把它开火。

Answer 1

我也赞成使用这个公式，我在你的文章的评论中给出的截图是使用公式推导出来的。 但是，既然你想要一个VBA代码，就这样了。

比方说，你的工作表看起来像这样

逻辑：

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

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

   • 达到这个目标

   

5. 接下来为输出创build2个表单。 我们将连续logging输出到Consecutive表，并将多个logging输出到Multiple表

6. 过滤列Col I Yes ，并将它们移到Consecutive表
7. 过滤Col J Non Blanks并将其移动到Multiple表
8. 根据Col J对Multiple表中的数据进行sorting
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 

输出：

Answer 2

公式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的数据并复制到所需的表格。