Сортировка данных в ячейке, удаление дублей

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Сортировка данных в ячейке, удаление дублей (Макросы/Sub)

ceHnau

Дата: Среда, 07.07.2021, 15:15 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 0 ±

Замечаний: 20% ±

2016

Здравствуйте!

Данная тема уже поднималась, однако требуемого решения найти и не удалось.

Все макросы есть(в файле примере), находил отдельно рабочие функции, но в виду моей криворукости и малых знаний, свести все воедино с нужными мне параметрами не получается. Уже часа 4 сижу.
Все до чего дошел - могу выделить только одну ячейку, далее текст копируется на отдельный лист, там макросом разбивается, блин, еще Месседж бокс каждый раз спрашивает про разделитель (он у меня всегда по умолчанию пробел), макросом удаляются дубли, им же соединяется, после чего копируется в ранее выделенную ячейку. Вариант рабочий, но долгий.

В идеале получить не функцию, а макрос, в теле которого бы добрый человек пометил [vba]

Код

'место, где можно заменить стандартный разделитель используемый при поиске, или перечислить нужные через запятые

[/vba] и [vba]

Код

'место, где можно заменить стандартный разделитель, выдаваемый после объединения

[/vba]. Без всякий Месседж боксов. Если же макросом можно будет выделять диапазон ячеек - вообще супер!

К сообщению приложен файл: 9963261.xlsm (40.3 Kb)

Ответить

Pelena

Дата: Среда, 07.07.2021, 17:29 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19404

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

Здравствуйте.
Воспользовалась Готовым решением

К сообщению приложен файл: 7159983.xlsm (41.2 Kb)

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

nilem

Дата: Среда, 07.07.2021, 17:45 | Сообщение № 3

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

или такой вариант:
[vba]

Код

Sub ertert()
Dim x, i&, j&, sp
x = Selection.Value 'предварительно выделить несколько ячеек в одной колонке
If Not IsArray(x) Then Exit Sub

'http://www.excelworld.ru/board/vba/tricks/obekt_arraylist/9-1-0-49
With CreateObject("System.Collections.ArrayList")
    For i = 1 To UBound(x)
        sp = Split(x(i, 1), " ") ' " " исходный разделитель пробел
        For j = 0 To UBound(sp)
            If Not .Contains(CStr(sp(j))) Then .Add CStr(sp(j)) 'только уникальные
        Next j
        .Sort    'сортируем
        x(i, 1) = Join(.ToArray, "; ") ' "; " конечный разделитель двоеточие с пробелом
        .Clear
    Next i
End With
Selection.Offset(, 1).Value = x 'в соседнюю колонку пишем результат
End Sub

[/vba]