如何使用VBA从excel中的列中删除所有重复项，只留下没有重复的行？答案

【问题标题】：How to remove all duplicates from a column in excel using VBA only leaving rows that have no duplicate?如何使用VBA从excel中的列中删除所有重复项，只留下没有重复的行？
【发布时间】：2019-06-21 03:37:58
【问题描述】：

我正在尝试从 Excel 中的一列数字中删除所有重复值。我希望剩余的列仅包含原始表中的唯一值。

我尝试过使用 RemoveDuplicates 方法，但它只删除了重复项的单个实例，而不是全部。

我也尝试过使用以下代码，但它与 RemoveDuplicates 存在相同的问题。我不知道为什么，因为“唯一”标签设置为“真”。

{MYWORKSHEET]AdvancedFilter Action:= _
    xlFilterCopy, CopyToRange:=[MYWORKSHEET].Range("B1"), Unique:=True

我只找到了一种理论上应该可行的解决方案，它使用嵌套的 For 循环遍历每一行并检查它是否与表中的任何其他行等效。唯一的问题是这会使我的机器上的 Excel 崩溃，因为它必须循环太多。除了这种蛮力方法，还有什么方法可以做到这一点？

这就是我要找的东西：

|-------| |----------------| |-------------------|
| INPUT | | DESIRED OUTPUT | | WHAT I DONT WANT  |
|-------| |----------------| |-------------------|
| 11111 | |      11111     | |       11111       |
|-------| |----------------| |-------------------|
| 22222 | |      55555     | |       22222       |
|-------| |----------------| |-------------------|
| 33333 |                    |       33333       |
|-------|                    |-------------------|
| 22222 |                    |       55555       |
|-------|                    |-------------------|
| 33333 |
|-------|
| 55555 |
|-------|

【问题讨论】：

其他列中是否有需要保留的数据？
也许你可以结合使用循环和过滤器
每个数字，即使它有重复，也是一个唯一的数字。请回答@JimmyShoe 问题，您需要保留列数据吗？
@JimmyShoe 不，只有一列数据，我可以从工作表中完全删除每个重复项

标签： excel vba

【解决方案1】：

将Advanced Filter 与公式标准一起使用，例如：=COUNTIF($A$6:$A$11,A6)=1

结果：

如果您需要改用公式，您可以执行以下操作：

=IFERROR(INDEX(inputTbl,AGGREGATE(15,6,1/(COUNTIF(inputTbl[Input],inputTbl[Input])=1) * ROW(inputTbl)-ROW(inputTbl[#Headers]),ROWS($1:1))),"")

【讨论】：

这个最适合我的情况，感谢您的解决方案！

【解决方案2】：

您可以将值加载到字典中并将键的值设置为 false，检查键是否存在，如果存在则将值更改为 true。遍历字典并仅转储错误的键。

dim mydict as object
dim iter as long
dim lastrow as long
dim cellval as string
dim dictkey as variant

set mydict = createobject("Scripting.Dictionary")

with activesheet

    lastrow = .Cells(.Rows.Count, "ColumnLetter").End(xlUp).row

    for iter = 1 to lastrow
        cellval = .cells(iter, "ColumnLetter").value
        if not mydict.exists(cellval) then
            mydict.add cellval, False
        else
            mydict(cellval) = True
        end if
    next
    iter = 1
    for each dictkey in mydict
        if mydict(dictkey) = False then
            .cells(iter, "ColumnLetter").value = dictkey
            iter = iter + 1
        end if
    next
end with

【讨论】：

【解决方案3】：

嗯，这是一个实际执行删除操作的宏，或者至少可以帮助您开始：

Private Sub CommandButton1_Click()
    Dim celll, rng As Range
    Dim strRow, strRowList As String
    Dim strRows() As String

    Set rng = Range("a1:a" & Range("a1").End(xlDown).Row)

    For Each celll In rng
        If celll.Address = rng(1, 1).Address Then
            If celll.Value = celll.Offset(1, 0).Value Then strRow = celll.Row
        ElseIf celll.Value = celll.Offset(-1, 0).Value Or celll.Value = celll.Offset(1, 0).Value Then
            strRow = celll.Row
        End If

        If strRowList = "" Then
            strRowList = strRow
        ElseIf strRow <> "" Then
            strRowList = strRowList & "," & strRow
        End If

        strRow = ""
    Next

    MsgBox (strRowList)

    strRows() = Split(strRowList, ",")

    For i = UBound(strRows) To 0 Step -1
        Rows(strRows(i)).Delete
    Next
End Sub

【讨论】：