Страницы: 1 2 След.
RSS
Исключить дублирование слов в одной ячейке через запятую
 
Добрый день всем! Заранее всех благодарю за помощь.
Проблема такая. Есть таблица, где в одном столбце записываются некоторые слова или цифры, а самая нижняя ячейка этого столбца должна собирать слова со всего столбца и записывать их в себя подряд через запятую.
Это сделано. Создал функцию, и она пишет все слова по порядку, добавляя запятую и пробел. Правда еще кривоватая, но не в этом дело.

Сама проблема: Если у нас в столбце имеются ячейки с одинаковыми записями, то естественно функция их заберет и впишет в нижнюю ячейку.. Хотелось бы избавиться от такого дублирования. Но я не могу понять как лучше это организовать.
В голову лезут коллекции или массивы, но это муторно как то...
Сам файл приложил.

Спасибо всем кто откликнется!
Изменено: SeregaMIHA - 12.03.2015 14:26:18
 
да чего там муторного. две строчки добавить, две изменить
Код
Function STexts2(Textrange As Range)
Dim Delimeter As String, i As Long
Delimeter = ", "
With CreateObject("scripting.dictionary")
    For i = 1 To Textrange.Cells.Count
        If Len(Textrange.Cells(i)) > 0 Then .Item(Textrange.Cells(i).Value) = i
    Next i
    STexts2 = Join(.keys, Delimeter)
End With
End Function
F1 творит чудеса
 
Как раз коллекции здесь и подошли бы))
 
вариант через коллекцию:

Код
Function STexts(Textrange As Range)
    Dim Delimeter As String, i As Long
    Delimeter = ", "
    With New Collection
        For i = 1 To Textrange.Cells.Count
            If Len(Textrange.Cells(i)) > 0 Then
                On Error Resume Next
                        Debug.Print .Count
                        .Add CStr(UCase(Textrange.Cells(i))), CStr(UCase(Textrange.Cells(i)))
                        If Err.Number = 0 Then 'если ошибки не возникло, значит в коллекции такого значения еще нет
                            OutText = OutText & Textrange.Cells(i) & Delimeter
                        Else
                            Err.Clear
                        End If
                On Error GoTo 0
            End If
        Next i
    End With
    STexts = Left(OutText, Len(OutText) - Len(Delimeter))
End Function
 
Ребята спасибо большущее вам! Очень помогли!
 
А с коллекцией то и муторно... :)
А On Error Resume Next в цикле не нужно  - зачем зря проц гонять...
Изменено: Hugo - 12.03.2015 16:46:28
 
Не тронь коллекции! ))
 
Hugo, пожалуй согласен
 
Все работает. Спасибо!
Правда оказалось не вся беда была в дублировании слов в нижней общей ячейке столбца F книги..
У нас есть 32 такие книги, они одинаковые правда с разными данными.
Нужно создать общую книгу, где в каждой ячейке столбца F будут ссылки на все 32 книги. Т.е в одной ячейке, например F2 общей книги мы сцепляем 32 ссылки на ячейки F2 книг одиночных.
Получается так, что если у нас в каких то книгах в ячейках совпадают значения или слова, то при консолидировании их в ячейке общей книги, у нас опять получится дублирование...
Я к этому вопросу не знаю с какой стороны подойти. В голову приходит только создавать какие то условия, если у нас текст по ссылке1 равен тексту по ссылке2 и 3, то отображать только одну их них..
Или может есть возможность запускать макрос при открытии общей книги, на всех ячейках столбца F, чтобы он удалял одинаковые слова.  Но там ссылки, как оно будет работать..
 
SeregaMIHA, а если Вам для общей книги написать отдельную функцию, которая будет разрезать итоговую строку на отдельные слова, а потом собирать обратно, но с проверкой на дубли?
ну это так, на уровне идеи...
 
Создать на спецлисте 32 ссылки в 32 ячейках на 32 книги, а уже из них  собирать без повторов уже готовой функцией от Максима.
 
Цитата
webley написал: ...написать отдельную функцию, которая будет разрезать итоговую строку на отдельные слова, а потом собирать обратно, но с проверкой на дубли?
Спасибо! Попробую, правда у меня вопрос как вообще ссылки и функция СЦЕПИТЬ работают? Т.е нам нужно запускать функцию только после того, как мы получили все данные, они записались в ячейку, мы их вынимаем, делаем с ними что хотим, а потом записываем обратно, переписав то что у нас было раньше.
Это наверное нужно создавать функцию и в коде уже все ссылки прописывать, тогда это меняет дело, оно сразу у нас будет записывать то что надо.
 
Hugo, я так думаю не получится - каждая из 32 ячеек будет состоять из уже собранных значений в разных комбинациях, т.е. вполне возможно, что дублей и не будет. насколько я понял исходную задачу - речь идет именно об удалении дублей значений, а не их комбинаций
 
Да.. Возможно дублей не будет. А возможно что их будет аж 32.
 
SeregaMIHA, в пользовательскую функцию можно передавать Сцепить(...) и в функции уже работать с этим как со строкой
 
Цитата
webley написал:
в пользовательскую функцию можно передавать Сцепить(...)
и будет Textrange.Cells.Count=1...
Или вообще не передадите - там ведь всюду Textrange As Range. Нужно переделывать код.
 
Hugo, так я же уже высказал свое мнение, что написанная функция для общей задачи не подойдет, т.к. задачи на отдельных  листах и на общем листе по сути разные
 
Я понял так - есть 32 файла с результатом в одной ячейке, и их нужно собрать без повторов в итоговый документ.
Ну вот ссылаемся на них в 32 ячейках одного листа этого документа, из которых и собираем нужную строку уже написанной UDF.
 
Спасибо большое за идеи! Я вот попробовал создать на отдельном листе столбец, где в каждой ячейке есть ссылки на 32 других книги. У нас там получаются подряд через запятую слова. Я попробовал на основном листе запустить пользовательскую функцию, ту про которую спрашивал вначале. Диапазон в ней я выбрал как раз из листа, где у нас ячейки со ссылками.
Но она отказывается работать.. Дублирование не убирает. Хотя думаю если ее как нибудь запустить, получится практически то что надо.
 
Ну она и не сработает. Т.к она рассматривает одну ячейку как одно слово. Блин...
 
Я предлагал не в одну 32, а в 32 по одной.
А вообще может мы просто друг друга не понимаем - покажите пример в файле, вместо других книг можно использовать пару других листов.
Изменено: Hugo - 13.03.2015 10:36:26
 
если у вас в каждой из собираемых ячеек (с 32 листов) уже содержится некий набор слов (например, при помощи функции из #2), и в итоговой ячейке вам надо собрать все-все вместе, еще раз убрав повторы, то можно функцию немного доработать:
Код
Function STexts2(Textrange As Range)
Dim Delimeter As String, i As Long, Aaa, Spart
Delimeter = ", "
With CreateObject("scripting.dictionary")
    For i = 1 To Textrange.Cells.Count
        If Len(Textrange(i)) > 0 Then
            Aaa = Split(Textrange(i).Value, Delimeter)
            If IsArray(Aaa) Then
                For Each Spart In Aaa
                    .Item(Spart) = i
                Next
            Else
                .Item(Aaa) = i
            End If
        End If
    Next i
    STexts2 = Join(.keys, Delimeter)
End With
End Function

В этом варианте она расщепляет значение ячейки по указанному разделителю и оставляет только уники. Т.е. из двух ячеек, например, "ма, ма, ма" и "1, 15, 2, 1" получится "ма, 1, 15, 2"
F1 творит чудеса
 
Цитата
SeregaMIHA написал:
Ну она и не сработает. Т.к она рассматривает одну ячейку как одно слово. Блин...
про что я и говорил
 
Максим Зеленский,
Вот это да!!! Спасибо вам огромнейшее! Работает!! Супер!
Осталось только разобраться, когда у нас в ячейке ссылки собирают слова, у нас кое где стоит лишняя запятая.

Доп лист - это лист где собираются ссылки.
Например в доп листе ячейка A2. Мы туда должны собрать подряд через запятую все слова из ячейки F2 всех 32х книг.
И так до А33й. Ячейка F34 основного общего листа, у нас собирает все уникальные слова из всех 32х документов. И вроде как все работает.
Вот как пример одна книга. ссылки я там на другие листы сделал.
Изменено: SeregaMIHA - 13.03.2015 11:36:42
 
Можно как-нибудь написать функцию СЦЕПИТЬ, так, чтобы она например не вставляла 3й текст, если 2й пустой?
Я написал вот так =СЦЕПИТЬ(Book1!F9;", ";Book2!F9;", ";Book3!F9;", ";Book4!F9;", ";Book5!F9).
Может можно как нибудь сделать, чтобы если у нас в 3й книге F9 пуста, тогда
запятую после не ставить? Функция от Максима работает прекрасно, если в доп листе не будет множества лишних знаков препинания, тогда будет все идеально.
 
Замените просто в результате две запятых на одну.
Вот так вроде бы под все варианты работает:
Код
=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,", , ,",","),", , ,",","),", ,",",")
Изменено: Hugo - 13.03.2015 11:46:35
 
Hugo,
Спасибо за подсказку!
Эту функцию как правильно записать? а то что то не получается. Вложить функцию в функцию вроде как всегда можно было, а тут не работает. (
У нас в итоговой таблице в ячейках вот так - =STexts2('Доп. лист'!A5). Функция Максима берет из сводного доп. листа ячейку убирает дубли и пишет в итоговую нам.
Тут и надо убирать запятые.
Изменено: SeregaMIHA - 13.03.2015 12:02:06
 
Вот там, где A1 - там и ставьте свой результат с лишними запятыми.
 
Вместо А1 можно как нибудь указать ссылку на другой лист, или лучше всего запустить функцию STexts с ссылкой - STexts2('Доп. лист'!A1) ???
 
Лучше всего исправить код STexts чтоб не допускала таких косяков.
Ну а пока можно как угодно - ссылаться на A1 как в примере, или брать результат прямо из функции.

Исправил (sorry Максим Зеленский, ну пока тебя нет...):
Код
Function STexts2(Textrange As Range)
Dim Delimeter As String, i As Long, Aaa, Spart
Delimeter = ", "
With CreateObject("scripting.dictionary")
    For i = 1 To Textrange.Cells.Count
        If Len(Textrange(i)) > 0 Then
            Aaa = Split(Textrange(i).Value, Delimeter)
            If IsArray(Aaa) Then
                For Each Spart In Aaa
                 If Len(Trim(Spart)) Then .Item(Spart) = i
                Next
            Else
                .Item(Aaa) = i
            End If
        End If
    Next i
    STexts2 = Join(.keys, Delimeter)
End With
End Function
Изменено: Hugo - 13.03.2015 12:20:26
Страницы: 1 2 След.
Наверх