在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