VBA 删除重复项

Posted 2023-03-29

【中文标题】VBA 删除重复项

【英文标题】：VBA delete duplicates

【发布时间】：2021-06-19 09:08:37

【问题描述】：

我一直在寻找 VBA 宏来查找重复项并删除重复项所在的行。

Dim Plage As Range
Dim Cel As Range
With Workbooks(Fichier).Worksheets("Facture")
'from A27 to A39
   Set Plage = .Range(.Cells(27, 1), .Cells(39, 1).End(xlUp))
End With
For Each Cel In Plage
    If Application.CountIf(Plage, Cel.Value) > 1 Then
        MsgBox "cel.row : " & Cel.Row
        If Cel.Row = 27 Or Cel.Row = 29 Or Cel.Row = 31 Or Cel.Row = 33 Or Cel.Row = 35 Or Cel.Row = 
        37 Or Cel.Row = 39 Then
            MsgBox "duplicate found"
            Cel.Interior.ColorIndex = 3
        Else ' duplicate on date => skip it
            MsgBox "duplicate date"
        End If
    End If
Next Cel

我的目标是保留一个副本，而不是全部删除，我有点迷路了：/ （我将使用 Selection.Delete Shift:=xlUp）

这就是结果（我只保留奇数行作为重复）。

编辑：This what i have right now

This what RemoveDuplicate gives me

EDIT2：添加 Workbooks(Fichier).Worksheets("Facture").Range("A" & Cel.Row & ":A" & Cel.Row + 1 & "").EntireRow.Select 而不是为单元格着色可以正常工作。

现在我需要获取之前删除的值 Range("A" & Cel.Row + 1 & "").Value 并将其添加到我保留的单元格中，例如 this

但我不知道如何保持非重复单元格地址的位置

【问题讨论】：

为什么不使用Range.RemoveDuplicates 它将保留第一个实例并删除所有其他实例。

保留一份副本？您想要一个副本，但不想更多？

RemoveDuplicate 只会删除它们，我需要删除行

我只想要一个

如果你尝试了@ScottCraner 的建议，你会实现你想要的。

【参考方案1】：

下面的代码将remove duplicate rows if you convert your data into an Excel Table。

Option Explicit
Sub RemoveDuplicates()
Dim TblRng As Range
Set TblRng = ActiveSheet.ListObjects("Table1").Range
TblRng.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

【讨论】：

谢谢，但它只是删除它，而不是删除行

【参考方案2】：

几乎找到了解决方案，它可以工作......现在很好

感谢帮助:)