Страницы: 1
RSS
Макрос по разнесению таблицы на разные вкладки
 
Добрый день!
Помогите, если не сложно, в написании макроса.
Задача, на первый взгляд, не сложная, но я, так как пока только начинаю работать с макросами немного забуксовал.

Итак задача:
На вкладке "выгрузка" есть таблица
В таблице есть колонка с метками (Тэгами)
Необходимо что бы макрос работал следующим образом: смотрел все листы в книге, и если на листе указан набор меток то копировал с листа "выгрузка" все строки, в которых присутствуют один или несколько, указанных на этом листе меток.
Те задачи, которые бы не попали ни на один из листов должны попасть на вкладку "Прочее"

Я уже написал небольшой простенький макрос, который по одной метке переносит строки (он во вложенном примере), что бы был понятен принцип работы.
Но вот несколько вопросов, на которые, я надеюсь вы мне поможете ответить своим решением:
1. Как осуществить неточный поиск? как видно из примера, метки не очень удобно лежат в таблице, просто перечислены через запятую. Я пока сделал по точному совпадению ячейки. А надо, что бы он, как бы, искал среди текста ячейки нужную метку и так же переносил эту строку даже если там присутствуют другие метки.
2. Решение первого вопроса осложняется следующим требованием: как-то отсеять метки, которые содержат в себе другие метки. Например, есть метка "ОД" а есть метка "ОД_2019", очевидно что при неточном поиске макрос найдет и первую и вторую метку. Но надо что бы если стоит метка "ОД" брал только эти строки а "ОД_2019" не трогал. (тут я полагаю только каким то костылем, типа, идет ли после тега запятая или пробел, но может быть есть красивое решение?)
3. Как в конце отметь все строки которые не были перенесены ни на одну из вкладок и перенести их на вкладку "Прочее"?

Заранее спасибо если кто то потратит время на эту задачку!



 
 
Почему сравнение идет только с ячейкой [b1], а значения присваиваете 3 переменным? Кстати, вы заметили как притормаживает макрос на такой маленькой таблице?
Я бы типизировал переменные, а не оставлял  их как Variant, да и не с листа на лист перекидывать можно, а все в массивах делать
Изменено: Nordheim - 19.06.2019 13:32:20
"Все гениальное просто, а все простое гениально!!!"
 
Меня сейчас будут пинать ногами профессионалы, но "вот это" работает.
Код
Option Explicit         ' Обязательное объявление переменных
Option Compare Text     ' отсутствие чувствительности к регистру при сравнении символов

Sub sortirovka_zadach()
    Const FirstRowVigruzka& = 2
    Const FirstRowRez& = 4
    Dim i&, ws As Worksheet, Tag&, A As String, B, ws2 As Worksheet, C, k&, D
    Dim s As Variant
    Application.ScreenUpdating = False
        For Each ws In ThisWorkbook.Worksheets
        With ws
        A = .Cells(1, 1).Value
        'MsgBox A
                If A = "Метки" Then
                B = .Cells(1, 2).Value
                C = .Cells(1, 3).Value
                D = .Cells(1, 4).Value
                Set ws2 = Лист3
                k = 0
                        With ws2
                            For i = 2 To 100
                                'C = .Range(.Cells(2, 3), .Cells(100, 3)).Value
                                For Each s In Split(.Cells(i, 3), ",")
                                    If s = B Or s = C Then
                                        .Range(.Cells(i, 1), .Cells(i, "P")).Copy
                                        '.Range(.Cells(2, 1), .Cells(2, 2)) = B
                                        ws.Cells(FirstRowRez + k, 1).PasteSpecial
                                        k = k + 1
                                        .Cells(i, 5).Value = 1
                                        GoTo NextS
                                    End If
NextS:
                                Next s
                            Next i
                        End With
                
                End If
        End With
        
        Next ws
        
        For Each s In ws2.Range("E2:e100")
            If s.Value <> 1 Then
                s.EntireRow.Copy
                Лист4.Cells(Лист4.Cells.SpecialCells(xlLastCell).Row, 1).End(xlUp).Offset(1).PasteSpecial xlPasteAll 'ну не знаю я как иначе найти последнюю строку
            End If
        Next s
        ws2.Range("E2:e100").Clear
        Application.CutCopyMode = False
End Sub
Я не волшебник, я только учусь.
 
1. Использовать instr - поиск совпадения строковых переменных (не актуально с учётом пункта 2).
2. Разделить значение в ячейке по ключевому символу (запятой) и сравнивать каждый элемент с нужными ключами
Код
For Each s In Split(.Cells(i, 3), ",")
    If s = B Or s = C Then
3. Делать какую-то метку, если строчка скопировалась, потом проверять эту метку и переносить. Метку удалить. Вероятно, правильнее и быстрее было бы заггнать значения с листа "Выгрузка" в массив и работать уже с ним, но для меня, как любителя, это сложновато.

Существенные косяки, которые заметил, пока писал пояснения:
1.  На листе "Выгрузка" в первом столбце куча единичек - не обращать внимания, это я входные данные в процессе тестирования испортил.
2. На лист "ОД ОД_B2B" скопировался столбец с единичками - тут нужно в коде поправить, чтобы копировались только первые 4 столбца, или единички писать куда-то дальше.
Изменено: Wiss - 19.06.2019 13:53:32
Я не волшебник, я только учусь.
 
С листом работать при больших объемах не вариант, если только времени не вагон, и можно покурить бамбук, пока там что то считается. Единственная загвоздка, у меня как не профессионала только в одном, это каждый раз пробегать по массиву сверяя метки. в итоге мы имеем количество циклов по одному массиву равное количеству листов на которые будут выгружаться данные.
Изменено: Nordheim - 19.06.2019 14:03:14
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Nordheim написал:
в итоге мы имеем количество циклов по одному массиву равное количеству листов на которые будут выгружаться данные.
Зачем? Можно же завести для каждого листа свой массив и свою переменную для сверки и для каждой строчки в массиве с данными проверять по очереди соответствие с условием для каждой таблицы и если нужно - копировать в массив таблицы 1. Так съестся больше памяти, но скорее всего это не критично.

Как говорится "Щас ещё понятнее поясню".
Код
Dim ArrZnach, ArrT1, ArrT2,Arrt3 'Массивы
Dim sU1, sU2, sU3 'Условия

For Each c In ArrZnach 
     If c=sU1 Then arrT1.add(c)
     If c=sU2 Then arrT2.add(c)
     If c=sU3 Then arrT3.add(c)
Next c
Да, массивы так не работают, но вроде бы должно быть понятнее, чем текст до этого.
Изменено: Wiss - 19.06.2019 14:17:56
Я не волшебник, я только учусь.
 
Цитата
Nordheim написал:
каждый раз пробегать по массиву сверяя метки. в итоге мы имеем количество циклов по одному массиву равное количеству листов
-  файл не смотрел, но по описанию задачи думаю что тут сгодится словарь - сперва в него собрать все метки (каждой как значение идентификатор листа), затем уже нет проблем одним циклом по данным раскопировать каждую текущую строку сразу куда нужно.
 
Hugo, да, со словарём вообще отлично получится.
Я не волшебник, я только учусь.
 
Цитата
Wiss написал:
Зачем? Можно же завести для каждого листа свой массив и свою переменную для сверки и для каждой строчки в массиве с
А если листов 200 шт. или более  сколько памяти съест массив, я бы не пошел по такому пути.
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Hugo написал:
думаю что тут сгодится словарь - сперва в него собрать все метки
могут быть затруднения, если метки на листах совпадут, то на какой лист вставлять значение. Поэтому я и задал вопрос "почему сверка идет только по одной ячейке", значения ячейки [b1] в листах на которые переносятся данные одинаковые.
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Nordheim написал:
могут быть затруднения, если метки на листах совпадут
Просто двумерный массив: Лист+метка и каждый раз пробегаться по всему. Если метка совпадает, то копировать на лист и проверять следующую метку. Пока писал понял, что может получиться, что запись соответствует листу по 2-м меткам и запись скопируется 2 раза, так что придётся завести дополнительный временный словарь, в котором хранить номера листов, куда запись уже скопирована. Зато этот словарь можно приспособить для выявления записей, которые никуда не попали и переносить их в "Прочее" 8)
Изменено: Wiss - 19.06.2019 14:53:43
Я не волшебник, я только учусь.
 
Цитата
Nordheim написал:
А если листов 200 шт.
Сложно спорить. Тут нужно более-менее представлять предполагаемый объём данных. Больше 5 листов по моему алгоритму обрабатывать будет уже себе дороже. Вариант - вместо 200 массивов для каждого листа - один трёхмерный массив.
Я не волшебник, я только учусь.
 
Цитата
Wiss написал:
Просто двумерный массив
Это можно реализовать и через словарь, без массива, имена (индексы листов), сцепить через разделитель в значение словаря, а потом (f)
Split распарсить, но это уже более сложный код получается, нежели представлен у ТС. Тут нужно всю логику прописывать заново. С временем засада, а так можно было бы заморочиться. Только я от автора так и не получил ответа, что есть метка
"Все гениальное просто, а все простое гениально!!!"
Страницы: 1
Наверх