VBA从第二列查找重复项并导出到第二行

我发现了一个很好的例子，我需要在这里做，但我必须find的重复是在第二列，我也必须从第二行粘贴到“重复”工作表。

例如，在源工作表中，我有以下内容

Class Name Age A John 10 A Maria 11 A John 12 B John 15 B Andy 10 B John 16 

而在复制工作表中，我想按如下方式获取重复项

 Class Name Age A John 10 A John 12 B John 15 B John 16 

我怎样才能改变这个代码来实现这一点：

 Dim wstSource As Worksheet, _ wstOutput As Worksheet Dim rngMyData As Range, _ helperRng As Range Set wstSource = Worksheets("Source") Set wstOutput = Worksheets("Duplicates") With wstSource Set rngMyData = .Range("A1:AQ" & .Range("A" & .Rows.Count).End(xlUp).Row) End With Set helperRng = rngMyData.Offset(, rngMyData.Columns.Count + 1).Resize(, 1) With helperRng .FormulaR1C1 = "=if(countif(C1,RC1)>1,"""",1)" .Value = .Value .SpecialCells(xlCellTypeBlanks).EntireRow.Copy Destination:=wstOutput.Cells(1, 1) .ClearContents End With 

Answer 1

看到注释行

 Dim wstSource As Worksheet, _ wstOutput As Worksheet Dim rngMyData As Range, _ helperRng As Range Set wstSource = Worksheets("Source") Set wstOutput = Worksheets("Duplicates") With wstSource Set rngMyData = .Range("A1:AQ" & .Range("A" & .Rows.count).End(xlUp).row) End With Set helperRng = rngMyData.Offset(, rngMyData.Columns.count + 1).Resize(, 1) With helperRng .FormulaR1C1 = "=if(countif(C2,RC2)>1,"""",1)" '<--| change references to column 2 .Value = .Value .SpecialCells(xlCellTypeBlanks).EntireRow.Copy Destination:=wstOutput.Cells(2, 1) '<--| start pasting from rew 2 .ClearContents End With