Страницы: 1 2 След.
RSS
Копирование из одного листа в другой с разделением текста по столбцам, доработать макрос
 
Добрейший вечерочек, господа!
Нужно доработать мой файл, в кооперативе там работают три макроса (У меня работает все на трех макросах и событиях в листах. Вы можете сделать как вы считаете лучше, жду ваших предложений) Главное получить результат в листе "Мясорубка"
Придумывать что то новое не нужно.
Просто нужно все функции этих макросов заставить работать воедино (либо предложить как доработать мою систему, чтобы она работала хорошо и быстро, либо переписать все это в один рабочий макрос, либо еще как..) по примеру описанному ниже.
Вот файл.
В листе "Мясорубка" пример того что должно получится.
Суть работы этого файла: Он из листа один копирует в лист "Мясорубка" далее он разделяет текст на слова из столбца А далее в итоговом столбце он собирает слова из всех столбцов.
 
 
Здравствуйте.
А где в примере в итоговом столбце собраны слова воедино? Вообще, можете на пальцах (без макросов) описать, что вы пытаетесь сделать? Вот есть исходная фраза, что с ней надо сделать, какой результат получить? А то непонятен смысл действий, (может там половина действий и не нужна вовсе), отсюда алгоритм не складывается.
Кому решение нужно - тот пример и рисует.
 
Пытливый, Столбец L - подписан: Итог.
Столбец А разделяются слова и вставляются в B столбец и далее по слову в ячейку. В итоговом столбце собираются все эти слова и сортируются от А до Я
Все действия там нужны. Как работают все эти три макроса, так работать и должно.
 
Где в примере в столбце L собранные слова? Там числа. Где в L3 собранные слова?

P.S.Ну раз как работают, так и должно - то и пускай работают. В чем вопрос-то тогда? :)

p.p.s. надо взять исходную фразу и слова из нее записать в ячейки L, за ней следующую фразу и т.д? А потом отсортировать?
Зачем тогда разбивать на слова и писать эти слова на лист? Это прям необходимо?
Изменено: Пытливый - 01.12.2018 21:17:43
Кому решение нужно - тот пример и рисует.
 
Цитата
Пытливый написал:
Где в примере в столбце L собранные слова? Там числа.
Покрутите ролик немного. Сортировка от А до Я стоит, т.е первыми будут числа.


Ну раз работают...
Сейчас все реализовано через события листа, нужно что бы все это автоматически срабатывало. И на данный момент таким методом у меня не срабатывют последние два макроса. Посмотрите события листа и поймете как все вместе работает. Вот и нужно получить что бы либо моим методом либо каким либо другим какой считаете лучше.. либо соединением всех моимх макросов в один, получить результат из листа Мясорубка.
Изменено: Gagarin13 - 01.12.2018 21:21:23
 
Цитата
Пытливый написал:
Зачем тогда разбивать на слова и писать эти слова на лист? Это прям необходимо?
Да, грубо говорят.. нужно взять весь пул текста из столбца А - разчленить это все по одному слову, и должно получится как в столбце с Итогом и отсортированным, ну там еще дубликаты должны удалятся, но это я уже сам потом доделаю, но все должно быть как я описал. Если думаете этап с разделением по столбцам лишний и его можно сделать проще, то буду рад вашим вариантам
 
Еще раз: Какой нужен конечный результат? Что вы хотите добиться? Вам нужны частота использования слов в запросах? Вам  нужные уникальные слова из запросов? Что?
Кому решение нужно - тот пример и рисует.
 
Цитата
Пытливый написал:
Еще раз: Какой нужен конечный результат? Что вы хотите добиться? Вам нужны частота использования слов в запросах? Вам  нужные уникальные слова из запросов? Что?
Столбец L- вот все что нужно. Должно получатся как файле.
1. Из листа1 копируются данные в Мясорубку
2. Не важно каким путем либо моим либо другим на ваше усмотрение, должен получится столбец L как в примере.
3. Все это начинает само работать, как только в Лист1 вставляют данные.
Цитата
Gagarin13 написал:
Да, грубо говорят.. нужно взять весь пул текста из столбца А - разчленить это все по одному слову, и должно получится как в столбце с Итогом и отсортированным, ну там еще дубликаты должны удалятся, но это я уже сам потом доделаю, но все должно быть как я описал.
 
Взять пул из столбца А - забирайте в массив.
Расчленить по одному слову - члените элементы массива через Split по пробелу
Пишете полученные "расчлененки" в коллекцию (тем самым СРАЗУ убираете дубликаты)
Как все запишете - циклом по столбцу L вставляете элементы коллекции в столбец
Потом столбец L сортируете.
И всю это красоту вешаете на событие активации целевого листа. С отключением обновления экрана в начале и включением в конце.
Как-то так. Сам писать не буду. :)
Изменено: Пытливый - 01.12.2018 21:59:13
Кому решение нужно - тот пример и рисует.
 
Пытливый, Ну так расписать конечно я тоже могу)) Но сам код так правильно, и адекватно прописать я не могу, как вы могли заметить я не силён в VBa)) Нужно либо готовое такое решение, либо до настроить мой криво настроенный файл. =(
 
Цитата
Пытливый написал: Еще раз: Какой нужен конечный результат? Что вы хотите добиться? ...Что?
Пытливый, какой Вы быстрый :D . Только 7-е сообщение. В предыдущей теме от ТС две страницы добивались ЧТО он хочет, пока тему не закрыли :D  
Согласие есть продукт при полном непротивлении сторон
 
Ну человек в правильную сторону движется, и правильные вопросы задает....
Изменено: Gagarin13 - 01.12.2018 22:20:49
 
Цитата
Gagarin13 написал: ...и правильные вопросы задает....
Мы сначала Вас для него подготовили... ;)  
Согласие есть продукт при полном непротивлении сторон
 
Давайте снова дичь не разводить тут, и писать по теме.
 
пишите
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Gagarin13 написал: Да, грубо говорят..
Если бы еще вчера написали просто, по-русски, что Вам нужно получить Отсортированный список уникальных слов из заданных фраз (это можно, кстати, как название темы использовать), то давно бы уже получили решение.
В модуль листа
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2")) Is Nothing Then
    Dim arrA(), I&, J&, splitA
    On Error Resume Next
    arrA = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
    With CreateObject("Scripting.Dictionary")
        For I = 1 To UBound(arrA)
            splitA = Split(arrA(I, 1))
            For J = 0 To UBound(splitA)
                If Not IsEmpty(splitA(J)) Then
                    iTemp = .Item(splitA(J))
                End If
            Next
        Next
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Range("B2").Resize(UBound(.Keys) + 1) = Application.Transpose(.Keys)
    End With
    With Me.Sort
        .SortFields.Add Key:=Range("B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Apply
    End With
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Изменено: Sanja - 02.12.2018 10:46:39
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Пытливый написал:
Пишете полученные "расчлененки" в коллекцию (тем самым СРАЗУ убираете дубликаты)
Пардон, коллекция прекрасно кушает дубликаты.
 
Цитата
StoTisteg написал: коллекция прекрасно кушает дубликаты
Как значения - да, а вот как ключи коллекции - нет
Согласие есть продукт при полном непротивлении сторон
 
Sanja, ключи у коллекции числовые и генерируются автоматически. А коллекция с задаваемыми пользователем ключами называется словарь...
 
Смелое, а главное самоуверенное утверждение :)  
Согласие есть продукт при полном непротивлении сторон
 
Ну тогда я хочу посмотреть на написанный Вами же макрос выше, только без строки
Код
With CreateObject("Scripting.Dictionary")
зато с использованием вместо этого объекта, описанного как
Код
Dim Col As Collection
Чисто для общего образования.
 
Цитата
StoTisteg написал: написанный Вами же
Кеми же 'Вами же'? Про коллекции говорил тов.Пытливый,  
Согласие есть продукт при полном непротивлении сторон
 
Цитата
StoTisteg написал: Чисто для общего образования.
Ну например так
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2")) Is Nothing Then
    Dim arrA(), I&, J&, N&, splitA
    Dim iCol As New Collection
    On Error Resume Next
    arrA = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
    ReDim arrB(0 To UBound(arrA))
    With iCol
        For I = 1 To UBound(arrA)
            splitA = Split(arrA(I, 1))
            For J = 0 To UBound(splitA)
                If Not IsEmpty(splitA(J)) Then
                    .Add Empty, splitA(J)
                    If err = 0 Then
                        arrB(N) = splitA(J)
                        N = N + 1
                    Else
                        err.Clear
                    End If
                End If
            Next
        Next
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Range("B2").Resize(UBound(arrB)) = Application.Transpose(arrB)
    End With
    With Me.Sort
        .SortFields.Add Key:=Range("B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Apply
    End With
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Угу. Только вот уникальных значений этот код не отберёт, похоже.
 
Цитата
StoTisteg написал: похоже
А попробовать самому?
Согласие есть продукт при полном непротивлении сторон
 
StoTisteg, в чём сомнения? ))
Вы полагаете, что коллекция не сможет отобрать уникальные значения?
 
Sanja, Ваш макрос конечно вроде работает, но есть один нюанс. Он в столбце B вставляет слова только до последней заполненной ячейки в столбце A. Т.е если я вставляю в столбце A две фразы (две ячейки заполненые) в каждой фразе по 7 слов уникальных, и того в столбце B должно быть 14 слов.. но их там будет 2, потому что две ячейки заполнены в А. + Еще если старые данные не очищать, то он ставит по верх них и вообще дичь получается.
Изменено: Gagarin13 - 02.12.2018 15:29:30
 
Цитата
Gagarin13 написал: но их там будет 2
А Вы проверяли? Я вставлял в ячейку A2 и одну ячейку и несколько и столбец целиком, все работало корректно.
Можно, на всякий случай указать весь столбец A во второй строке кода
Код
If Not Intersect(Target, Columns(1)) Is Nothing Then
А вот это вообще не понятно
Цитата
Gagarin13 написал: Еще если старые данные не очищать, то он ставит по верх них и вообще дичь получается
А что нужно делать со старыми данными? Что такое 'дичь'?
Похоже вчерашняя сказка про 'белого бычка' повторяется.
Вы можете словами полностью описать всю задачу?
Изменено: Sanja - 02.12.2018 16:18:59
Согласие есть продукт при полном непротивлении сторон
 
Sanja, а Вы оптимист! :)
Кому решение нужно - тот пример и рисует.
 
Пытливый,  :D  
Согласие есть продукт при полном непротивлении сторон
Страницы: 1 2 След.
Наверх