在A列中查找重复项，复制行并删除

Question

这不应该是复杂的代码，但我是Excel VBA的新手。我尝试了许多不同的方法，结果导致了错误、无限循环和错误的选择。

我开发了一小段代码，用于查找列A中的重复项并删除其中一个重复项。

  Sub Statistique()
  Dim LastRow As Long
  Set x = ActiveWorkbook.Sheets("COPYRIGHT")
  LastRow = Range("A65536").End(xlUp).Row
  For x = LastRow To 3 Step -1
 If Application.WorksheetFunction.CountIf(Range("A3:A" & x), Range("A" & x).Text) > 1 Then
                        Range("A" & x).EntireRow.Delete
                    End If
               Next x

现在，我希望通过复制要删除的行中的非空单元格并将它们粘贴到将保留的行中来改进代码。这意味着我希望将非空单元格复制到上面的第一个重复行上，复制到它们之前的同一列中。

有什么想法吗？

Answer 1

试试这个：

Sub Statistique()

    Dim rngColA As Range

    Set rngColA = Worksheets("COPYRIGHT").Range("A1").EntireColumn
    rngColA.RemoveDuplicates 1, xlGuess

End Sub

或

Sub Statistique2()

    Dim rngColA As Range

    Set rngColA = Worksheets("COPYRIGHT").Cells
    rngColA.RemoveDuplicates 1, xlGuess

End Sub