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

【问题标题】：VBA find duplicates from 2nd column and export to second rowVBA从第二列查找重复项并导出到第二行
【发布时间】：2017-03-13 02:01:15
【问题描述】：

我找到了一个很好的例子来说明我需要做什么here，但是我必须找到的重复项在第二列中，而且我必须从第二行开始粘贴到“重复”工作表中。

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

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

【问题讨论】：

标签： vba excel

【解决方案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

【讨论】：

完美！！谢谢。