删除列中重复的单元格内容答案

【问题标题】：Delete Duplicate Cell Contents in Column删除列中重复的单元格内容
【发布时间】：2017-03-20 04:10:55
【问题描述】：

我正在尝试删除单个列中重复单元格的内容。我想保留条目的第一次出现，但删除它下面的所有重复项。

我只能找到删除整行而不清除内容的代码。

Sub Duplicate()

With Application
    ' Turn off screen updating to increase performance
    .ScreenUpdating = False
    Dim LastColumn As Integer
    LastColumn = Cells.Find(What:="*", After:=Range("U1"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    With Range("U1:U" & Cells(Rows.Count, 1).End(xlUp).Row)
        ' Use AdvanceFilter to filter unique values
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
        .SpecialCells(xlCellTypeVisible).Offset(0, LastColumn - 1).Value = 1
        On Error Resume Next
        ActiveSheet.ShowAllData
        'Delete the blank rows
        Columns(LastColumn).SpecialCells(xlCellTypeBlanks).Cells.Clear
        Err.Clear
    End With
    Columns(LastColumn).Clear
    .ScreenUpdating = True
End With

End Sub

【问题讨论】：

只需使用显示的任何算法来检测重复单元格，然后使用cells.clear 方法而不是使用entirerow.delete 方法。如果它不起作用，请发布您的代码。
@RonRosenfeld 我只能找到删除所有条目并且不保留第一次出现的代码。我编辑了我的帖子以显示我正在尝试使用的代码。
我发布了一些你可以使用的东西，它使用了不同的算法。高级过滤器似乎不适合您的目的。

标签： vba excel

【解决方案1】：

这是一种方法。我们从列的底部开始向上工作：

Sub RmDups()
    Dim A As Range, N As Long, i As Long, wf As WorksheetFunction
    Dim rUP As Range

    Set A = Range("A:A")
    Set wf = Application.WorksheetFunction

    N = Cells(Rows.Count, "A").End(xlUp).Row

    For i = N To 2 Step -1
        Set rUP = Range(Cells(i - 1, 1), Cells(1, 1))
        If wf.CountIf(rUP, Cells(i, 1).Value) > 0 Then Cells(i, 1).Clear
    Next i
End Sub

我们检查上面是否有任何重复项，如果是则清除单元格。之前：

之后：

编辑#1：

对于列U：

Sub RmDupsU()
    Dim U As Range, N As Long, i As Long, wf As WorksheetFunction
    Dim rUP As Range

    Set U = Range("U:U")
    Set wf = Application.WorksheetFunction

    N = Cells(Rows.Count, "U").End(xlUp).Row

    For i = N To 2 Step -1
        Set rUP = Range(Cells(i - 1, "U"), Cells(1, "U"))
        If wf.CountIf(rUP, Cells(i, "U").Value) > 0 Then Cells(i, "U").Clear
    Next i
End Sub

【讨论】：

这在我尝试时适用于 A 列。我尝试通过将 A 替换为 U 来编辑 U 列，但它仍然只适用于 A 列。不确定代码的哪一部分需要要改变.. 似乎我们已经接近了。
@RS 查看我的 EDIT#1
@RS 感谢您的反馈，
我的代码遇到了最后一个问题，但我在 90 分钟内无法再次发布。也许你可以看看..（见编辑）。非常感谢您的帮助！
我已经为此发布了新帖子，因为它是一个单独的问题：stackoverflow.com/questions/41637407/…

【解决方案2】：

我的 0.02 美分

Sub main()
    Dim i As Long
    With Range("A1", Cells(Rows.Count, 1).End(xlUp))
        For i = 1 To .Rows.Count - 1
            .Range(.Cells(i + 1, 1), .Cells(.Rows.Count)).Replace what:=.Cells(i, 1).Value, replacement:="", lookat:=xlWhole
        Next i
    End With
End Sub

【讨论】：

【解决方案3】：

这是一个可行的例程。如有必要，可以大大加快速度：

编辑：我将列号更改为列字母，如果您想要“A”以外的列，则需要在其中进行更改

Option Explicit
Sub ClearDups()
    Dim R As Range
    Dim I As Long
    Dim COL As Collection

Set R = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))
Set COL = New Collection

On Error Resume Next
For I = 1 To R.Rows.Count
    COL.Add Item:=R(I, 1), Key:=CStr(R(I, 1))
    Select Case Err.Number
        Case 457 'Duplicate test (Collection object rejects duplicate keys)
            Err.Clear
            R(I, 1).ClearContents
        Case Is <> 0  'unexpected error
            MsgBox Err.Number & vbLf & Err.Description
    End Select
Next I
On Error Goto 0


End Sub

【讨论】：

【解决方案4】：

    'This code crisply does the job of clearing the duplicate values in a given column
    Sub jkjFindAndClearDuplicatesInGivenColumn()
        dupcol = Val(InputBox("Type column number"))
        lastrow = Cells(Rows.Count, dupcol).End(xlUp).Row
        For n = 1 To lastrow
        nval = Cells(n, dupcol)
            For m = n + 1 To lastrow
            mval = Cells(m, dupcol)
                If mval = nval Then
                Cells(m, dupcol) = ""
                End If
            Next m
        Next n
    End Sub

【讨论】：