Question

我找到了一个非常好的例子，我需要做什么here，但我必须找到的副本位于第二列，而且我必须粘贴“重复”字样。工作表从第2行开始。

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

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

在Duplicate工作表中，我想获得重复项，如下所示

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

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

1 个答案: