Excel VBA Макросы: Удаление повторяющихся значений в ячейках.

[Rengame113]

В столбце F идут ячейки с повторяющимися значениями, разделенные "; ".
Каким образом можно удалить повторяющиеся фразы в ячейке чтобы осталось одна фраза?
Повторений в некоторых ячейках может и не быть.

Пример:
F1 Привет друг; Привет друг
F2 Сегодня хорошая погода.; Сегодня хорошая погода.
F3 Хороший день!
F4 Пока!; Пока

[вложение удалено администратором]

[Администратор]

Макрос

Sub макрос()

    Dim arr(), lr As Long, i As Long
   
   
    '1. Копирование данных из экселя в vba-массив.
        ' С vba-массивом макрос быстрее работает, чем с эксель-ячейками.
        ' И код может быть удобнее для чтения.
    ' Поиск последней строки. Метод 'End' не учитывает скрытые ячейки.
    lr = Cells(Rows.Count, "F").End(xlUp).Row
    ' Копирование данных в массив.
    arr() = Range("F1:F" & lr).Value
   
    '2. Обработка данных.
    ' Цикл по массиву.
    For i = 1 To UBound(arr)
        ' Обработку делаем в отдельной процедуре для удобства чтения кода.
            ' В процедуру передаём текущую ячейку массива.
        Work arr(i, 1)
    Next i
   
    '3. Вставка обработанных данных обратно на лист.
        ' При вставке из vba-массива, не должно быть скрытых строк на листе.
    Range("F1:F" & lr).Value = arr()
   
    '4. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub

Private Sub Work(data)

    Dim cln As Collection, var, i As Long
   
   
    '1. Создание коллекции.
        ' С помощью коллекции можно получить уникальные данные, отбросив повторы.
    Set cln = New Collection
   
    '2. Копируем данные из ячейки массива в переменную 'var'.
    var = data
   
    '3. Разбиваем данные по сочетанию 'точка с запятой + пробел'.
    var = Split(var, "; ")
   
    '4. Записываем уникальные данные в коллекцию.
   
    '1) Включение перехватчика ошибок, что макрос продолжил работу, когда произойдёт ошибка.
        ' Ошибка произойдёт, если в коллекции уже будут такие данные.
    On Error Resume Next
   
    '2) Цикл по фразам. Порядковая нумерация фраз будет начинаться с нуля, а не 1,
        ' как это привычно для человека.
    For i = 0 To UBound(var)
        ' Копирование фразы в коллекцию.
            ' Данные записываем в Key, чтобы собирать уникальные данные,
            ' и в Item, чтобы потом взять данные.
        cln.Add key:=var(i), Item:=var(i)
    Next i
   
    '3) Отключение перехватчика ошибок, т.к. ошибок больше не ожидается.
    On Error GoTo 0

    '5. Копируем данные из коллекции в массив 'var'.
    ' Создаём ячейки в массиве. Создаём столько ячеек, сколько элементов в коллекции.
        ' Делаем тип данных 'Variant', чтобы не было путаницы, т.к.
        ' тип данных останется от предыдущего использования.
    ReDim var(1 To cln.Count) As Variant
    ' Копируем данные из коллекции в массив.
    For i = 1 To cln.Count
        var(i) = cln(i)
    Next i
   
    '6. Объединяем ячейки массива 'var' черех сочетание 'точка с запятой + пробел'
        ' и записываем полученную строку в ячейку массива 'arr'.
    data = Join(var, "; ")

End Sub

[свернуть]

[Rengame113]

спасибо