макрос для объедения ячеек

[vitek9603]

Народ помогите чайнику решить простую для Вас задачу

нужно сделать объеденение ячеек и удаление дубликатов
Посмотрите пожалуйста образец там лучше поймете о чем я прошу.
Спасибо

[vitek9603]

Ни кто не может помочь?

[kuklp]

Я вижу у себя см. скрин. С такой помойкой работать - никакого желания. Конвертировать в правильную кодировку тем паче. Мне не настолько нечего делать. Это форум по Экселю. Почему файлы не в формате xls?

P.S. Почему Вы считаете, что задача простая? Откуда такая уверенность? Это тоже напрягает. Не судите о том, в чем ни бельмеса не понимаете.

[vitek9603]

простите щас исправлю

[vitek9603]

Исправил....

[kuklp]

Вам точно такой результат надо?
Тогда выделите столбец - Данные -расширенный фильтр - только уникальные.

[vitek9603]

Простите не правильно сохранил, скачайте еще раз там щас все правильно в архиве
Извините меня)
В первом столбе должны объединиться все категории

[kuklp]

Public Sub www()
    Dim a, i&, b
    a = [a1].CurrentRegion
    With CreateObject("scripting.dictionary")
    For i = 1 To UBound(a)
        .Item(a(i, 2)) = .Item(a(i, 2)) & vbLf & a(i, 1)
    Next
    a = .keys: b = .items
    For i = 0 To UBound(a)
        Cells(i + 1, 4) = a(i): Cells(i + 1, 5) = b(i)
    Next
    End With
End Sub

[vitek9603]

РАБОТАЕТ СПАСИБОООО
Добавь в скайп плиз.
Как мне тебя отблагодарить?

[kuklp]

C каких пор мы на ТЫ?
А насчет благодарности - реквизиты в подписи.