Создание пользовательских функций для удаления дубликатов и сортировки полученных значений в ячейке

[Denis Ch]

Здравствуйте уважаемые форумчане.
Прошу оказать помощь в написании пользовательской(-их) функции(-й) которые бы удаляли дублирующиеся значения в ячейке, а затем отсортировывали их в порядке возрастания(или убывания). Решения по сортировке и удалению дубликатов для диапазонов нашёл, а для ячейки нет.
Два дня с файлом мучаюсь, для удаления дубликатов в массиве значений использовал таблицы google и функцию UNIQUE, а сортировку приходилось делать в ручном режиме. Для написания подобных пользовательских функций опыта не хватает, помогите пожалуйста.
Удаление дубликатов нужно сделать для ячеек в столбце X в прикреплённом примере это ячейки X2 и X5).
Версия excel 2013, пример сохранён именно в ней. Сохранить в .xls, не получается так как у меня там очень большие формулы и большое количество символов в ячейке, которое не поддерживается excel 2003.

[IgorGO]

при активном листе выполните этот

Sub DelSort()
  Dim a, n As Long
  a = Split(Cells(2, 24), ";"):  n = UBound(a) + 1
  Cells(1, 9999).Resize(n) = WorksheetFunction.Transpose(a)
  Cells(1, 9999).Resize(n).RemoveDuplicates Columns:=1, Header:=xlNo
  n = WorksheetFunction.Count(Columns(9999))
  Application.ScreenUpdating = False
  With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Cells(1, 9999).Resize(n, 1), SortOn:=xlSortOnValues, _
                    Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Cells(1, 9999).Resize(n, 1): .Header = xlGuess: .MatchCase = False
    .Orientation = xlTopToBottom: .SortMethod = xlPinYin: .Apply
  End With
  Cells(2, 25) = Join(WorksheetFunction.Transpose(Cells(1, 9999).Resize(n, 1).Value), ";")
  Columns(9999).ClearContents:   Application.ScreenUpdating = True
End Sub

см. в Y2 собрано все лучшее из X2

[Hugo121]

Например так.
Немного коряво вышло, но работает!
Использовал наработку SAS888
Работает только с числами!
Можно конечно применять сразу в X2 и X5.

P.S.Похоже с названием накосячил - какое там uniqstrings, раз работает только с числами?...
Ну да ладно, исправьте на что хотите...

[Denis Ch]

Сообщение от IgorGO

при активном листе выполните этот

Sub DelSort()
  Dim a, n As Long
  a = Split(Cells(2, 24), ";"):  n = UBound(a) + 1
  Cells(1, 9999).Resize(n) = WorksheetFunction.Transpose(a)
  Cells(1, 9999).Resize(n).RemoveDuplicates Columns:=1, Header:=xlNo
  n = WorksheetFunction.Count(Columns(9999))
  Application.ScreenUpdating = False
  With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Cells(1, 9999).Resize(n, 1), SortOn:=xlSortOnValues, _
                    Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Cells(1, 9999).Resize(n, 1): .Header = xlGuess: .MatchCase = False
    .Orientation = xlTopToBottom: .SortMethod = xlPinYin: .Apply
  End With
  Cells(2, 25) = Join(WorksheetFunction.Transpose(Cells(1, 9999).Resize(n, 1).Value), ";")
  Columns(9999).ClearContents:   Application.ScreenUpdating = True
End Sub

см. в Y2 собрано все лучшее из X2

IgorGO, большое спасибо.
Проверил код, для ячейки X2 сработал, отсортировал как надо и удалил лишнее. Чтобы в ячейке Х5 убрать лишнее нужно в коде адрес ячейки менять, я правильно понимаю? А можно сделать так, чтобы для выбранной ячейки выполнялся этот макрос или чтобы выводился запрос какую ячейку оптимизировать и куда вывести результат. Вывод результата в столбец Y вполне устраивает, но неудобно каждый раз в макрос изменения вносить. Вас не затруднит немного код подправить, чтобы удобнее было пользоваться?

[IgorGO]

в начале:

 a = Split(Selection, ";"):  n = UBound(a) + 1

в конце

Selection.Offset(0, 1) = Join(WorksheetFunction.Transpose(Cells(1, 9999).Resize(n, 1).Value), ";")

результат будет правее исходной ячейки

[Hugo121]

А мой вариант может сразу в исходной, и динамически, и без кнопки...
И ничего на листе не затрёт...
Зря что ли писал?

[Denis Ch]

Сообщение от Hugo121

Например так.
Немного коряво вышло, но работает!
Использовал наработку SAS888
Работает только с числами!
Можно конечно применять сразу в X2 и X5.

P.S.Похоже с названием накосячил - какое там uniqstrings, раз работает только с числами?...
Ну да ладно, исправьте на что хотите...

Огромное вам спасибо Hugo121,
Формула работает. Плохо, что массивы констант типа {1;2;5;10;56;87;2}, не обрабатывает и работает только с числовыми значениями. Можно ли доработать функцию, чтоб она более универсальной и "всеядной" стала?
P.s. IgorGO, Hugo121 большое спасибо что так быстро откликнулись и помогли с решением задачи.Проверьте ваши "места сбора благодарностей" указанные в подписях

[IgorGO]

спасибо!

зафиксирован факт пополнения кошелька.

[Hugo121]

Спасибо, пополнение прибыло.
Доработать можно, но в примере всегда предусмотрены числа - поэтому использовал решение для чисел.
Можно взять любой готовый код сортировки массива и использовать - будет для любых значений.
А вот про массив не понял - покажите пример в файле, подумаю.

P.S. Вот для чисел и строк. Ещё можно для дат доработать...

Option Explicit

Function uniqel(s$, razd$) As String
    Dim col As New Collection, el, i&, j&, k&
    Dim x&, y&

    If InStr(s, razd) Then
        On Error Resume Next
        For Each el In Split(s, razd)
            el = Trim(el)
            col.Add el, el
        Next
        On Error GoTo 0

        ReDim a(1 To col.Count)
        For Each el In col
            i = i + 1
            If IsNumeric(el) Then a(i) = --el Else a(i) = el
        Next

        SortArray a

        uniqel = Join(a, razd)
    End If
End Function

Private Sub SortArray(ByRef a As Variant)
    Dim i As Long, j As Long
    Dim t As Variant

    'standard bubble sort loops
    For i = LBound(a) To UBound(a) - 1
        For j = i + 1 To UBound(a)
            If a(i) > a(j) Then    'change to < for descending order
                t = a(i)
                a(i) = a(j)
                a(j) = t
            End If
        Next j
    Next i
End Sub

[Denis Ch]

Hugo121,
когда я писал про массив то имел ввиду возможность использовать запись следующего вида =uniqel({1;2;5;6;8;9;2};";"), т.е. чтобы можно было использовать как ссылку на ячейку так и использовать массив констант. Я планировал использовать эту формулу в составе других формул, а там у меня иногда массивы констант проскакивают. Сейчас она ругается на запись в виде {1;2;5;6;8;9;2}, вместо ссылки на ячейку.