Как исключить повторяющиеся значения?

Question

[Владимир]

Добрый день. Помогите пожалуйста разобраться с небольшой проблемой. Есть несколько книг, с них в основную книгу сводятся значения диапозонов через гиперссылки. Проблема в том что в одну и туже ячейку могут попасть одиннаковые данные и ячейка примет оба этих значения. Подтянуты ячейки из других книг зачастую имеют одинаковые значения. Как исключить одинаковые значения и вывести только уникальные?

Возможно ли это сделать через формулу?

Пример формулы ячейки вытягивающей информацию из других книг: ='С:\[1.xlsb]лист'!A1&'С:\[2.xlsb]лист'!A1&'С:\[3.xlsb]лист'!A1

в книге 1.xlsb ячейка А1 имеет значение 1
в книге 2.xlsb ячейка А1 имеет значение 1
в книге 3.xlsb ячейка А1 имеет значение 2

Конечный итог ячейки А1 в основной книге будет выглядить 112
Хотелось бы получить результат 12

Comments

[Александр]

Как вывести повторяющееся значение?

В вашем случае нужно выводить уникальные.

[Владимир]

Александр, Да, отредактировал вопрос

[Владимир]

Нашёл макрос

Sub Delete_Duplicates()
    Dim col As New Collection
    Dim i As Integer
    On Error Resume Next
 
    For Each cell In Selection
        Set col = Nothing
        sResult = ""
         
        'делим текст в ячейке по пробелам
        arWords = Split(WorksheetFunction.Trim(cell.Value), " ")
         
        'проходим в цикле по всем получившимся словам
        For i = LBound(arWords) To UBound(arWords)
            Err.Clear                           'сбрасываем ошибки
            col.Add arWords(i), arWords(i)      'пробуем добавить слово в коллекцию
            'если ошибки не возникает, то это не повтор - добавляем слово к результату
            If Err.Number = 0 Then sResult = sResult & " " & arWords(i)
        Next i
        cell.Value = Trim(sResult)      'выводим результаты без повторов
    Next cell
End Sub

Всем спасибо!!! Вопрос закрыт

[Александр]

Владимир, поместите свой комментарий в ответ и отметьте этот ответ решением.

Answer 1

[Владимир]

Нашёл макрос

Sub Delete_Duplicates()
Dim col As New Collection
Dim i As Integer
On Error Resume Next

For Each cell In Selection
Set col = Nothing
sResult = ""

'делим текст в ячейке по пробелам
arWords = Split(WorksheetFunction.Trim(cell.Value), " ")

'проходим в цикле по всем получившимся словам
For i = LBound(arWords) To UBound(arWords)
Err.Clear 'сбрасываем ошибки
col.Add arWords(i), arWords(i) 'пробуем добавить слово в коллекцию
'если ошибки не возникает, то это не повтор - добавляем слово к результату
If Err.Number = 0 Then sResult = sResult & " " & arWords(i)
Next i
cell.Value = Trim(sResult) 'выводим результаты без повторов
Next cell
End Sub

Всем спасибо!!! Вопрос закрыт