Question

我正在尝试从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 |
|-------|

Answer 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))),"")

Answer 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

Answer 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

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

3 个答案: