Удалить дубликаты из ячейки

#excel

Подсмотрел у жены задачу. Есть лист эксель с ячейками:



Нужно найти и удалить все задвоения чисел внутри каждой ячейки.

Пример: 

Есть ячейка 53 45 67 89 23 53 45

Нужно оставить только первое вхождение 53, а второе - удалить. (Дополнение от A K
-- видимо и 45, тоже дублируется)

Есть ли какие-то простые способы сделать это? Я бы пошёл путём написания макроса
(повод вспомнить vba), но может есть какие-то готовые встроенные функции?
    

Ответы

Ответ 1

Есть способ, но вряд ли будет проще :)

Применим на небольшом количестве ячеек с данными. Тест: диапазон из 30 ячеек обработан
за 4 минуты.

Выделить диапазон, закладка Данные-Текст_по_столбцам-с_разделителями-Далее, разделитель
пробел-Готово. Получили каждое число в отдельной ячейке. 

Правее в верхней строке диапазона (в примере - строка 4) пишем формулу:

=ЕСЛИ(ПОИСКПОЗ(A4:I4;A4:I4;)=СТОЛБЕЦ(A4:I4);A4:I4)


Протягиваем формулу по всем строкам. Формула может показывать ошибку - ничего срашного.

Дальше нудное (чем больше строк, тем дольше): выделить формулу в строке формул, последовательно
нажать F9-Enter - получим результат вычислений формулы. Для исходного текста  53 45
67 89 23 53 45 полученный результат:

={53;45;67;89;23;ЛОЖЬ;ЛОЖЬ;#Н/Д;#Н/Д}


После преобразования всех формул выделить диапазон с формулами, с помощью инструмента
НАЙТИ/ЗАМЕНИТЬ удалить знаки и выражения

= (равно), {} (фигурные скобки каждая отдельно), ЛОЖЬ, #Н/Д

Сдвоенную точку с запятой (;;) заменить несколько раз на точку с запятой.

Точку с запятой (;) заменить на пробел. В ячейках останутся уникальные числа, записанные
через пробел. Последний штрих: удалить использованные столбцы.

----------------------


Поигрались? Теперь возвращаем данные на место и обрабатываем макросом :)

Sub DelDuplNum()
Dim ar(), aSpl
Dim lRw As Long
Dim i As Long, j As Long, p As Long
    With ActiveSheet
        lRw = .Cells(.Rows.Count, 1).End(xlUp).Row
        If lRw < 4 Then Exit Sub
        ar = .Range("A1:A" & lRw).Value

        For i = 4 To lRw
            aSpl = Split(ar(i, 1), " "): ar(i, 1) = aSpl(0)

            For j = 0 To UBound(aSpl) - 1
                For p = j + 1 To UBound(aSpl)
                    If aSpl(j) <> "" Then
                        If aSpl(j) = aSpl(p) Then aSpl(p) = ""
                    End If
                Next p
            Next j

            For j = 0 To UBound(aSpl)
                If aSpl(j) <> "" Then ar(i, 1) = ar(i, 1) & " " & aSpl(j)
            Next j
        Next i

        .Range("A1:A" & lRw).Value = ar
    End With
End Sub


Ответ 2

Скопировать столбец в Notepad++
Заменить (\b(\d+)\b.*) \2\b на \1 с использованием регулярных выражений
Нажимать Заменить все до тех пор, пока не получится 0 замен
Скопировать получившиеся данные и вставить обратно в Excel


Ответ 3

Полу-VBA :)

Вариант решения с помощью функции пользователя и использования в ней словарей.

В общем модуле разместить код:

Function DelDupl(r As Range) As String
Dim aSpl, txt
    aSpl = Split(r, " ")

    With CreateObject("Scripting.Dictionary")
        For Each txt In aSpl: .Item(txt) = 0&: Next txt
        DelDupl = Join(.keys, " ")
    End With
End Function


В ячейку строки с данными вписать формулу:

=DelDupl(A4)


Протянуть по строкам. При желании выделить диапазон строк, копировать, Вставить_как_значения

Примечание: на MAC'е не применять, он со словарями не работает.

' --------------


Совсем без VBA и ручного вмешательства

Вариант1. Проще и понятнее.



а) Разбиваем по ячейкам. Формула в D4 (копируется в диапазон D:M):

=СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(" "&$A4;" ";ПОВТОР(" ";99));СТОЛБЕЦ(A1)*99;99))


б) Удаляем повторы. Формула в N4 (копируется в диапазон N:W):

=ЕСЛИ(ПОИСКПОЗ(D4;$D4:$M4;)=СТОЛБЕЦ(A1);D4;"")&" "


в) Показываем результат. Формула в B4 (копируется в столбец B):

=СЖПРОБЕЛЫ(N4&O4&P4&Q4&R4&S4&T4&U4&V4&W4)


Вариант2. Формула сложнее и непонятнее )



а) Разбиваем по ячейкам и удаляем повторы. Формула в D4 (копируется в диапазон D:M):

=ЕСЛИ(СЧЁТЕСЛИ($C4:C4;СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(" "&$A4;" ";ПОВТОР(" ";99));СТОЛБЕЦ(A1)*99;99))&"
");"";СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(" "&$A4;" ";ПОВТОР(" ";99));СТОЛБЕЦ(A1)*99;99))&" ")


б) Показываем результат. Формула в B4 (копируется в столбец B):

=СЖПРОБЕЛЫ(D4&E4&F4&G4&H4&I4&J4&K4&L4&M4)


Вариант3. Одной формулой.

Практически невозможен, т.к. нужно сздавать в памяти массивы, а текстовые функции
не умеют работать в формулах массива.


Ответ 4

Все предыдущие решения требуют либо VBA либо дополнительных действий, т.е. не будут
работать при динамическом изменении данных. Единственное ограничение в моем решении
- кол-во чисел в исходной строке, для 2010 Excel - кол-во столбцов 16384, значит в
исходной строке не может быть больше (16384-2)/4=4095 чисел. Можно объединить 5 и 6
блоки, тогда чисел может быть 5460.



Формулы:

Блок 1: Исходная строка

Блок 2: Уникальные значения

B3 =AL3

Блок 3: Позиция пробела (для разбивки строки на отдельные числа)

C3 =ЕСЛИ(ЕОШ(НАЙТИ(" ";$A3;1));ДЛСТР($A3)+1;НАЙТИ(" ";$A3;1))

D3 - K3 =ЕСЛИ(ЕОШ(НАЙТИ(" ";$A3;C3+1));ДЛСТР($A3)+1;НАЙТИ(" ";$A3;C3+1))

Блок 4: Числа из исходной текстовой строки

L3 =ПСТР($A3;1;C3-1)

M3 - T3 =ЕСЛИ(D3>C3;ПСТР($A3;C3+1;D3-C3-1);"")

Блок 5: Определяем "уникальность" числа (считаем сколько раз это число встречается
от начала блока то текущего столбца, если 1 - то число уникально)

U3 - AC3 =СЧЁТЕСЛИ($L3:L3;L3)

Блок 6: Сцепляем уникальные числа, отделяя их друг от друга пробелами

AD3 =ЕСЛИ(U3=1;L3;"")

AE3 - AL3 =ЕСЛИ(V3=1;СЦЕПИТЬ(AD3;" ";M3);AD3)


Ответ 5

У меня была аналогичная задача. Нашел код, который: 


мне абсолютно непонятен.
работает как нужно.




Выделить диапазон, запустить макрос

Sub bb()
    Dim c As Range, x
    With CreateObject("scripting.dictionary") ' создаем объект - словарь
        For Each c In Selection ' цикл по выделенному диапазону
            .RemoveAll ' чистим словарь

            ' при заполнении словаря метод Item позволяет
            ' обходить ошибку при добавлении дубля ключа
            ' ранее записанное значение заменяется новым
            ' т. е. практически - удаление дублей
            For Each x In Split(c) ' цикл по фрагментам текста
                .Item(x) = 0
            Next

            ' массив, состоящий из всех ключей, имеющихся в коллекции
            c = Join(.keys)
        Next
    End With
End Sub