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