Макрос, удаление дублей по маске

Пользователь

Сообщений: 21 Регистрация: 01.01.1970

21.02.2009 14:51:37

Понадобился вот такой вот макрос.

Таблица А:
111111:ппппппп@111111:ппппппп@55345.ftp.543534534.ru/53453453.ru/www
вававававава:oojaiH4j@вававававава:oojaiH4j@neels.ru
..........:444444444444@..........:444444444444@444444444444444444.ru
prima:fffffffffffff@prima:fffffffffffff@gral.rudddd

Таблица В (Результат)
111111:ппппппп@55345.ftp.543534534.ru/53453453.ru/www
вававававава:oojaiH4j@neels.ru
..........:444444444444@444444444444444444.ru
prima:fffffffffffff@gral.rudddd

Как именно он должен это сделать.
В наших строках присутствует повторение некоторых вещей через @
"111111:ппппппп@" и "111111:ппппппп@"

"вававававава:oojaiH4j@" и "вававававава:oojaiH4j@"

"..........:444444444444@" и "..........:444444444444@"

"prima:fffffffffffff@" и "prima:fffffffffffff@"

Вот такие дубли и надо убрать во всех строках Таблицы А, и получившееся поместить в Таблицу В. Всё остальное оставляем без изменений. Дубли убираем только вот по тому принцыпу что я написал выше, то есть "*:*@". Если строка не содержит никаких таких дублей - ничего в ней не меняя тоже пишем её в Таблицу В.
Заренее спасибо.

p.s. шаблон здесь http://slil.ru/26937210

слэн Пользователь Сообщений: 5192 Регистрация: 16.01.2013	#2 21.02.2009 16:34:57 тест по столбцам, транспонировать, убрать дубликаты(или расш фильтр, только уникальные), транспонировать обратно, склеить.. можно записать макрорекордером Живи и дай жить..

grooogler Пользователь Сообщений: 21 Регистрация: 01.01.1970	#3 21.02.2009 17:02:46 знал бы как эту абракадабру сделать, не обращался бы ;) буду очень благодарен.

** ТУРБО-ЁЖ **

Пользователь

Сообщений: 189 Регистрация: 01.01.1970

21.02.2009 23:52:04

Ловите эксклюзивную пользовательскую функцию. ;)

Function Two2One(Text As String) As String
Dim Polki, i As Byte, tmp As String
Application.Volatile
Polki = Split(Text, "@")
For i = 1 To UBound(Polki)
If InStr(1, Polki(i), ":") > 0 Then
If Polki(i) <> Polki(i - 1) Then tmp = tmp & "@" & Polki(i)
Else: tmp = tmp & "@" & Polki(i)
End If
Next
Two2One = Polki(0) & tmp
End Function

Пользуем как обычно: код кидаем в обычный модуль (Insert -> Module), а в ячейке пишем формулу:
=Two2One(A1)
и тянем, тянем… :)

слэн Пользователь Сообщений: 5192 Регистрация: 16.01.2013	#5 22.02.2009 14:57:07 а точно дубликаты только друг за другом идут? или могут быть разнесены? Живи и дай жить..

Читают тему