Excel Vba复制重复值并将其粘贴另一张

Question

我使用Excel宏对数据进行排序，其中如果发生任何相同的数据，则应将其复制到新工作表中。对于多种类型的数据，将使用多张纸。举例来说，如果我有以下数据：

col1 col2 col3 
101 cs  abc 
102 ds  cdf 
101 cs  abc 
102 ds  cdf 
102 ds  cdf 
103 cs  efg 
104 cs  jsj 

我只想数据，其中COL2 =“CS”所以，如果101和CS到来的第一次那么它不应该被计算在内。如果count超过一个，那么整行应该被复制并粘贴到一张新纸上。对于其余到达者，应该采取相同的过程......即， 103，104等等等等.....宏这在我以前是..

Private Sub Workbook_Open() 
    Dim i 
    Dim LastRow As Long 
    LastRow = Sheets("Sample1").Range("A" & Rows.Count).End(xlUp).Row 
    Sheets("Sheet1").Range("A2:I500").ClearContents 
    For i = 2 To LastRow 
     If Sheets("Sample1").Cells(i, "E").Value = "Customer" Then 
      Count = Count + 1 
      If Count > 1 Then 
       Sheets("Sample1").Cells(i, "E").EntireRow.Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1) 
      End If 
     End If 
    Next i 
End Sub 

Answer 1

您应该从计数行的开头的值的次数的数目，直到循环值-I-：

Dim i 
Dim LastRow As Long 
LastRow = Sheets("Sample1").Range("A" & Rows.Count).End(xlUp).Row 
Sheets("Sheet1").Range("A2:I500").ClearContents 
For i = 2 To LastRow 
    If Sheets("Sample1").Cells(i, "E").Value = "Customer" Then 
    Count = Application.WorksheetFunction.CountIf(Range("B1:B" & i), Sheets("Sample1").Cells(i, "B")) 
     If Count > 1 Then 
      Sheets("Sample1").Cells(i, "E").EntireRow.Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1) 
     End If 
    End If 
Next i