Как удалить все дубликаты из столбца в Excel с помощью VBA, оставив только строки, которые не имеют дубликатов?

Question

Я пытаюсь удалить все повторяющиеся значения из столбца чисел в Excel.Я хочу, чтобы в оставшемся столбце только содержали уникальные значения из исходной таблицы.

Я пытался использовать метод RemoveDuplicates, но он удаляет только один экземпляр дубликата вместо всех.

Я также пытался использовать следующий код, но у него та же проблема, что иRemoveDuplicates.Я не уверен, почему, хотя, поскольку для тега «Unique» установлено значение «True».

{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