Новости:

Прикрепить к сообщению можно только файлы xls, gif, jpg, rar, zip,7z, bas, frm, cls, doc размером до 150 Кб.

Главное меню

Нужно удалять дубликаты слов по строкам внутри каждой ячейки.

Автор spono, 20.07.2015, 12:29

« назад - далее »

spono

Здравствуйте, помогите пжл:
Нужно реализовать макрос, который будет удалять дубликаты слов по строкам внутри каждой ячейки, при этом слова из разных ячеек сравниваться не будут.
Пример дубля слово: canon ir-3225<br> в файле double-20.07.2015.xlsx Ячейка D5

Serge 007

Здравствуйте

Почему canon ir-3225<br> является дублем, если сравнивать макрос должен построчно?
Ведь в пятой строке нет ещё хотя бы одного "слова" canon ir-3225<br>
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

spono

Макрос должен сравнивать слова построчно внутри каждой ячейки.
А в ячейке D5 слово canon ir-3225<br> повторяется дважды.

содержание ячейки D5:
canon ir-2230<br>
canon ir-2270<br>
canon ir-2270i<br>
canon ir-2830<br>
canon ir-2870<br>
canon ir-2870f<br>
canon ir-2870i<br>
canon ir-3025<br>
canon ir-3025n<br>
canon ir-3025ne<br>
canon ir-3030<br>
canon ir-3230<br>
canon ir-3225<br>
canon ir-3225<br>
canon ir-3225n<br>
canon ir-3235<br>
canon ir-3235i<br>
canon ir-3235n<br>
canon ir-3245<br>
canon ir-3245i<br>
canon ir-3245n<br>
Canon IR-3225e<br>
Canon IR-3225Ne<br>
Canon IR-3245e<br>
Canon IR-3245Ne<br>

cheshiki1

макрос проходится по столбцу D (4 столбец) и в каждой ячейке удаляет дубли.
Sub vvv()
Dim n, i#, sd As Object
For i = 7 To Cells(Rows.Count, 4).End(xlUp).Row
Set sd = CreateObject("Scripting.Dictionary")
    For Each n In Split(Cells(i, 4), Chr(10))
     sd.Item(n) = ""
    Next
Cells(i, 4) = Join(sd.keys, Chr(10))
Next
End Sub

spono

Я нажал Alt+F11 - Эта книга - Insert - Module затем Сохранился.
Выбрал стиль ссылок R1C1
Лента Разработчик - Макросы - vvv - Выполнить
Ничего не происходит - дубли строк в ячейках макрос не удаляет.

Serge 007

spono, зачем Вы процитировали пост целиком?
Вам предупреждение за оверквотинг
Пока просто предупреждение
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

cheshiki1

баловался с макросом менял начало цикла и назад не вернул :).
исправьте i=7 на, вроде (по памяти), i=4 (т.е. первую проверяемую строку столбца D)

spono

Заработало )) спасибо.
Скажие пжл, а как сделать так, чтобы макрос удалял дубли слов вне зависимости от их регистра?

Например:
AAA
BBB
CCC
aaa
DDD

cheshiki1


spono

Я вставил код: sd.Item(UCase(n))= "" в макрос, он удалил дубли, но при этом заменил регистр у букв ((
А как сделать так, чтобы регистр букв не менялся, а дубли удалялись в не зависимости от регистра букв?

cheshiki1

проверяйте
Sub vvv()
Dim n, i#, sd As Object, mas(), ii#
For i = 4 To Cells(Rows.Count, 4).End(xlUp).Row
Set sd = CreateObject("Scripting.Dictionary")
    For Each n In Split(Cells(i, 4), Chr(10))
      If Not sd.Exists(UCase(n)) Then
         sd.Item(UCase(n)) = ""
         ReDim Preserve mas(ii)
         mas(ii) = n
         ii = ii + 1
      End If
    Next
Cells(i, 4) = Join(mas, Chr(10))
Next
End Sub

spono

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

cheshiki1

УПС. забыл обнулить массив.
Sub vvv()
Dim n, i#, sd As Object, mas(), ii#
For i = 4 To Cells(Rows.Count, 4).End(xlUp).Row
Set sd = CreateObject("Scripting.Dictionary")
    For Each n In Split(Cells(i, 4), Chr(10))
      If Not sd.Exists(UCase(n)) Then
         sd.Item(UCase(n)) = ""
         ReDim Preserve mas(ii)
         mas(ii) = n
         ii = ii + 1
      End If
    Next
Cells(i, 4) = Join(mas, Chr(10))
ii = 0
Erase mas
Next
End Sub

spono

Да, макрос превосходно работает, удаляет дубли строк вне зависимости от регистра символов!!!
;D Спасибо  ;D

RAN

Не знаю, как далеко поезд ушел, но танец с бубном покороче так
sd.CompareMode = vbTextCompare