Добрый день! Уважаемые форумчане помогите решить, в одном столбце практически в каждой ячейке есть повторяющиеся слова и знаки, пример:
Фильтр воздушный для BMW X5 E70, BMW X5 E70, X5 E70 Фильтр для BMW 7 E65, , , , , , , , BMW 7 E65, , , , , , , , BMW 7 E65, , , , , , ,
есть вот такой макрос
[vba]
Код
Sub bb() Dim c As Range, x, nbsp$ nbsp = Chr$(160) With CreateObject("scripting.dictionary") For Each c In Selection .RemoveAll For Each x In Split(Application.Trim(Replace$(c, nbsp, " ")), ",") x = Trim(x) .Item(x) = 0 Next c = Join(.keys, ", ") Next End With End Sub
[/vba]
но он все-таки удаляет не все дубли, помогите понять почему? файл прицепил
Добрый день! Уважаемые форумчане помогите решить, в одном столбце практически в каждой ячейке есть повторяющиеся слова и знаки, пример:
Фильтр воздушный для BMW X5 E70, BMW X5 E70, X5 E70 Фильтр для BMW 7 E65, , , , , , , , BMW 7 E65, , , , , , , , BMW 7 E65, , , , , , ,
есть вот такой макрос
[vba]
Код
Sub bb() Dim c As Range, x, nbsp$ nbsp = Chr$(160) With CreateObject("scripting.dictionary") For Each c In Selection .RemoveAll For Each x In Split(Application.Trim(Replace$(c, nbsp, " ")), ",") x = Trim(x) .Item(x) = 0 Next c = Join(.keys, ", ") Next End With End Sub
[/vba]
но он все-таки удаляет не все дубли, помогите понять почему? файл прицепилpashatank
Спасибо RAN, сейчас действительно с дублями справляется, но макрос ставит запятую там где ее быть не должно: Фильтр для, BMW 7 E65, можно попросить тогда без дублей символов, только слова? А запятые я потом другим макросом почищу.
Спасибо RAN, сейчас действительно с дублями справляется, но макрос ставит запятую там где ее быть не должно: Фильтр для, BMW 7 E65, можно попросить тогда без дублей символов, только слова? А запятые я потом другим макросом почищу.pashatank
Сообщение отредактировал pashatank - Четверг, 23.08.2018, 18:38
Dim spl For Each c In Selection .RemoveAll spl = Split(c, "для") For Each x In Split(Replace$(spl(1), nbsp, " "), ",") If x <> Chr(32) Then .Item(x) = 0 Next c = spl(0) & " " & Join(.keys, ", ") Next
[/vba]
[vba]
Код
Dim spl For Each c In Selection .RemoveAll spl = Split(c, "для") For Each x In Split(Replace$(spl(1), nbsp, " "), ",") If x <> Chr(32) Then .Item(x) = 0 Next c = spl(0) & " " & Join(.keys, ", ") Next
Sub bb() Dim spl For Each c In Selection .RemoveAll spl = Split(c, "для") For Each x In Split(Replace$(spl(1), nbsp, " "), ",") If x <> Chr(32) Then .Item(x) = 0 Next c = spl(0) & " " & Join(.keys, ", ") Next c = Join(.keys, ", ") Next End With End Sub
[/vba]
ругается invalid or unqualified reference и отсылает на .RemoveAll, что не так сделал?
Вставил, но вот по такой конструкции
[vba]
Код
Sub bb() Dim spl For Each c In Selection .RemoveAll spl = Split(c, "для") For Each x In Split(Replace$(spl(1), nbsp, " "), ",") If x <> Chr(32) Then .Item(x) = 0 Next c = spl(0) & " " & Join(.keys, ", ") Next c = Join(.keys, ", ") Next End With End Sub
[/vba]
ругается invalid or unqualified reference и отсылает на .RemoveAll, что не так сделал?pashatank
А чем словарь обидел? Зачем его надо было удалять? [vba]
Код
Sub bb() Dim c As Range, x, nbsp$ nbsp = Chr$(160) With CreateObject("scripting.dictionary") Dim spl For Each c In Selection .RemoveAll spl = Split(c, "для") For Each x In Split(Replace$(spl(1), nbsp, " "), ",") If x <> Chr(32) Then .Item(x) = 0 Next c = spl(0) & " " & Join(.keys, ", ") Next End With End Sub
[/vba]
А чем словарь обидел? Зачем его надо было удалять? [vba]
Код
Sub bb() Dim c As Range, x, nbsp$ nbsp = Chr$(160) With CreateObject("scripting.dictionary") Dim spl For Each c In Selection .RemoveAll spl = Split(c, "для") For Each x In Split(Replace$(spl(1), nbsp, " "), ",") If x <> Chr(32) Then .Item(x) = 0 Next c = spl(0) & " " & Join(.keys, ", ") Next End With End Sub
Ну, это все в силу малограмотности ) Но теперь код удаляет "для" и вместо "Фильтр для BMW 7 E65", остается только "Фильтр воздушный BMW X5 E70". И выдает Run-time error 9: Subscript out of range, а debag шлет сюда:
[vba]
Код
For Each x In Split(Replace$(spl(1), nbsp, " "), ",")
[/vba]
Может по другому попробовать решить, прицепил с удаленными лишними запятыми, осталось только дубли слов убрать, пример: Фильтр воздушный для BMW X5 E70, BMW X5 E70 Фильтр для BMW 7 E65, BMW 7 E65, BMW 7 E65
чтобы осталось только Фильтр воздушный для BMW X5 E70 Фильтр для BMW 7 E65, BMW 7 E65
Опять же похоже вернулся к первому коду, чтобы удалял все дубли в строчке, с условием что будут удалены все дубли между запятыми и с запятой на конце, но не могу понять почему код не срабатывает в моем случае...
Ну, это все в силу малограмотности ) Но теперь код удаляет "для" и вместо "Фильтр для BMW 7 E65", остается только "Фильтр воздушный BMW X5 E70". И выдает Run-time error 9: Subscript out of range, а debag шлет сюда:
[vba]
Код
For Each x In Split(Replace$(spl(1), nbsp, " "), ",")
[/vba]
Может по другому попробовать решить, прицепил с удаленными лишними запятыми, осталось только дубли слов убрать, пример: Фильтр воздушный для BMW X5 E70, BMW X5 E70 Фильтр для BMW 7 E65, BMW 7 E65, BMW 7 E65
чтобы осталось только Фильтр воздушный для BMW X5 E70 Фильтр для BMW 7 E65, BMW 7 E65
Опять же похоже вернулся к первому коду, чтобы удалял все дубли в строчке, с условием что будут удалены все дубли между запятыми и с запятой на конце, но не могу понять почему код не срабатывает в моем случае...pashatank
Sub bb() Dim c As Range, x, nbsp$ nbsp = Chr$(160) With CreateObject("scripting.dictionary") For Each c In Selection .RemoveAll For Each x In Split(Application.Trim(Replace$(c, nbsp, " ")), ",") x = Trim(x) .Item(x) = 0 Next c = Join(.keys, ", ") Next End With End Sub
[/vba] добавить условие, что дубли в ячейках будут удаляться после слова "для", как это прописать?
Понял почему :facepalm: Нужно вот сюда [vba]
Код
Sub bb() Dim c As Range, x, nbsp$ nbsp = Chr$(160) With CreateObject("scripting.dictionary") For Each c In Selection .RemoveAll For Each x In Split(Application.Trim(Replace$(c, nbsp, " ")), ",") x = Trim(x) .Item(x) = 0 Next c = Join(.keys, ", ") Next End With End Sub
[/vba] добавить условие, что дубли в ячейках будут удаляться после слова "для", как это прописать?pashatank
Сообщение отредактировал pashatank - Пятница, 24.08.2018, 05:36
Уважаемые форумчане, помогите с вопросом пожалуйста, необходимо удалить повторяющиеся слова в ячейке, пример: Фильтр воздушный для BMW X5 E70, BMW X5 E70, BMW X5 E70, BMW X5 E70, Фильтр для BMW 7 E65, BMW 7 E65, BMW 7 E65, BMW 7 E65, BMW 7 E65, но, по условию, что удаляться дубли и последняя запятая будут после слова "для", вот в этот код надо условие вставить: [vba]
Код
Sub bb() Dim c As Range, x, nbsp$ nbsp = Chr$(160) With CreateObject("scripting.dictionary") For Each c In Selection .RemoveAll For Each x In Split(Application.Trim(Replace$(c, nbsp, " ")), ",") x = Trim(x) .Item(x) = 0 Next c = Join(.keys, ", ") Next End With End Sub
[/vba]
Уважаемые форумчане, помогите с вопросом пожалуйста, необходимо удалить повторяющиеся слова в ячейке, пример: Фильтр воздушный для BMW X5 E70, BMW X5 E70, BMW X5 E70, BMW X5 E70, Фильтр для BMW 7 E65, BMW 7 E65, BMW 7 E65, BMW 7 E65, BMW 7 E65, но, по условию, что удаляться дубли и последняя запятая будут после слова "для", вот в этот код надо условие вставить: [vba]
Код
Sub bb() Dim c As Range, x, nbsp$ nbsp = Chr$(160) With CreateObject("scripting.dictionary") For Each c In Selection .RemoveAll For Each x In Split(Application.Trim(Replace$(c, nbsp, " ")), ",") x = Trim(x) .Item(x) = 0 Next c = Join(.keys, ", ") Next End With End Sub
Ну для... тех танков, которые в танке, нужно так [vba]
Код
Sub bb() Dim c As Range, x, nbsp$ nbsp = Chr$(160) With CreateObject("scripting.dictionary") Dim spl For Each c In Selection .RemoveAll If InStr(c, "для") Then spl = Split(c, "для") For Each x In Split(Replace$(spl(1), nbsp, " "), ",") If x <> Chr(32) Then .Item(x) = 0 Next c = spl(0) & "для " & Join(.keys, ", ") & "," Else For Each x In Split(Replace$(c, nbsp, " "), ",") If x <> Chr(32) Then .Item(x) = 0 Next c = Join(.keys, ", ") & "," End If Next End With End Sub
[/vba]
Ну для... тех танков, которые в танке, нужно так [vba]
Код
Sub bb() Dim c As Range, x, nbsp$ nbsp = Chr$(160) With CreateObject("scripting.dictionary") Dim spl For Each c In Selection .RemoveAll If InStr(c, "для") Then spl = Split(c, "для") For Each x In Split(Replace$(spl(1), nbsp, " "), ",") If x <> Chr(32) Then .Item(x) = 0 Next c = spl(0) & "для " & Join(.keys, ", ") & "," Else For Each x In Split(Replace$(c, nbsp, " "), ",") If x <> Chr(32) Then .Item(x) = 0 Next c = Join(.keys, ", ") & "," End If Next End With End Sub
Sub bb() Dim arr() As Variant, i& With CreateObject("vbscript.regexp") .Pattern = "(?:([^,]+?),)(?=(?:.*?\1(?:,|$)))|(?:,\s*)+$|(?:(,)(\s)*){2,}" .Global = True: .MultiLine = True arr = Selection.Value For i = 1 To UBound(arr) If .test(arr(i, 1)) Then arr(i, 1) = .Replace(arr(i, 1), "$2$3") Next Selection.Value = arr End With End Sub
[/vba]
до кучи [vba]
Код
Sub bb() Dim arr() As Variant, i& With CreateObject("vbscript.regexp") .Pattern = "(?:([^,]+?),)(?=(?:.*?\1(?:,|$)))|(?:,\s*)+$|(?:(,)(\s)*){2,}" .Global = True: .MultiLine = True arr = Selection.Value For i = 1 To UBound(arr) If .test(arr(i, 1)) Then arr(i, 1) = .Replace(arr(i, 1), "$2$3") Next Selection.Value = arr End With End Sub
Ога, сам в шоке , сомневался, что в одну регулярку удастся запихнуть [vba]
Код
(?:([^,]+?),)
[/vba] Любое количество не запятых перед запятой. ? после + тут, в принципе, не нада. Удаляется при условии, что [vba]
Код
(?=(?:.*?\1(?:,|$)))
[/vba] находится перед любым количеством символов и таким же набором символов (обратная ссылка на захватываемую группу - \1 ), находящимся перед запятой или символом конца строки. да и тут одна вложенная незахватываемая группа лишняя [vba]
Код
(?:,\s*)+$
[/vba] Группа из запятой с последующим любым количеством пробельных символов повторяющаяся любое количество раз перед символом конца строки ($). Удаляются все [vba]
Код
(?:(,)(\s)*){2,}
[/vba] группа из запятой с последующим любым количеством пробельных символов повторяющаяся от 2х раз. Удаляются все повторы кроме последнего (за это отвечают указатели на захватываемые группы в маске замены - $2$3), оставляя последний пробельный символ, если их было >1 (из-за того, что счетчик * вынесен за скобки) Символ | между блоками - ИЛИ с поправками регулярка получилась [vba]
Ога, сам в шоке , сомневался, что в одну регулярку удастся запихнуть [vba]
Код
(?:([^,]+?),)
[/vba] Любое количество не запятых перед запятой. ? после + тут, в принципе, не нада. Удаляется при условии, что [vba]
Код
(?=(?:.*?\1(?:,|$)))
[/vba] находится перед любым количеством символов и таким же набором символов (обратная ссылка на захватываемую группу - \1 ), находящимся перед запятой или символом конца строки. да и тут одна вложенная незахватываемая группа лишняя [vba]
Код
(?:,\s*)+$
[/vba] Группа из запятой с последующим любым количеством пробельных символов повторяющаяся любое количество раз перед символом конца строки ($). Удаляются все [vba]
Код
(?:(,)(\s)*){2,}
[/vba] группа из запятой с последующим любым количеством пробельных символов повторяющаяся от 2х раз. Удаляются все повторы кроме последнего (за это отвечают указатели на захватываемые группы в маске замены - $2$3), оставляя последний пробельный символ, если их было >1 (из-за того, что счетчик * вынесен за скобки) Символ | между блоками - ИЛИ с поправками регулярка получилась [vba]
krosav4ig, макрос шустрый, но не всегда верно обрабатывает, например: "Фильтр для AUDI 80," вышло как: "Фильтр для AUDI 8". Прицепил пример, в первом листе, то что нужно обработать, а во втором, то что вышло.
krosav4ig, макрос шустрый, но не всегда верно обрабатывает, например: "Фильтр для AUDI 80," вышло как: "Фильтр для AUDI 8". Прицепил пример, в первом листе, то что нужно обработать, а во втором, то что вышло.pashatank
Sub bb() Dim arr() As Variant, i& With CreateObject("vbscript.regexp") .Pattern = "(?:([^,]+),)(?=(?:.*?,\1|\1)(?:,|$))|(?:,\s*)+$|(?:(,)(\s)*){2,}|\s+\K,\s*" .Global = True: .MultiLine = True arr = Selection.Value For i = 1 To UBound(arr) If .test(arr(i, 1)) Then arr(i, 1) = .Replace(arr(i, 1), "$2$3") Next Selection.Value = arr End With End Sub
[/vba] Одну запятую пока не удалось регуляркой отработать, сделал обычной заменой исправил регулярку, должно работать, проверряйте
[vba]
Код
Sub bb() Dim arr() As Variant, i& With CreateObject("vbscript.regexp") .Pattern = "(?:([^,]+),)(?=(?:.*?,\1|\1)(?:,|$))|(?:,\s*)+$|(?:(,)(\s)*){2,}|\s+\K,\s*" .Global = True: .MultiLine = True arr = Selection.Value For i = 1 To UBound(arr) If .test(arr(i, 1)) Then arr(i, 1) = .Replace(arr(i, 1), "$2$3") Next Selection.Value = arr End With End Sub
[/vba] Одну запятую пока не удалось регуляркой отработать, сделал обычной заменой исправил регулярку, должно работать, проверряйтеkrosav4ig
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
