Страницы: 1
RSS
Копирование / перенос значений подгрупп (группировок)
 
Доброго времени суток

есть постоянно обновляющийся файл (пример прилагается)
необходимо переносить/копировать наименования (для наглядности выделены цветом) из конкретных подгрупп на необходимый лист
в макросах не силен, формулами не получается, сводными таблицами громоздко и можно упустить новые названия, в возможности реализации задумки начинаю сомневаться

заранее благодарю за помощь
с уважением
 
assedo, у Вас всегда идёт такая очередность (подгруппа красная/подгруппа синяя) или это издержки примера?
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Владимир,
если Вы имеете введу индикация подгрупп цветом, то это издержки примера, для наглядности
подгруппы из которых необходимо переносить наименования могут быть подряд а могут быть в разных концах списка и не обязательно через одну (так пример получился)
Изменено: assedo - 26.07.2017 14:13:44
 
Тогда нужно думать.
-------
Более никаких признаков нет?  
Изменено: Владимир - 26.07.2017 14:24:54
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Владимир,
в том то и дело, что нет
теоретически может подойти вариант из темы Копирование группы товаров на новый лист с помощью макроса
но к сожалению не совсем понимаю макросы чтобы применить ее к своему варианту
 
Тогда проще всего сделать таблицу, которая идёт на ЛИСТ2 or 3 и обычным циклом, сверяясь с этой таблицей по имени..
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Владимир,
в любом случае благодарю за участие
... а если макросом копировать массив/диапазон (подгруппа товаров ААА)+1:(группа товаров 2)-1 на "лист1" далее копировать (подгруппа товаров ВВВ)+1:(группа товаров 3)-2 на первую пустую ячейку "лист1" А:А .... ну итак далее и на следующий лист
как то так, кто б теперь это в коде изобразил )))
ведь теоретически можно один раз посидеть и забить в ручную диапазоны от и до для каждой подгруппы, названия групп и подгрупп неизменно. правда может возникнуть конфликт из-за одинаковых названий подгрупп.  
Изменено: assedo - 26.07.2017 15:13:41
 
Цитата
assedo написал:
подгруппа товаров ААА)
подгруппа товаров ВВВ
У Вас в примере таких подгрупп не видно. Руками нарисуйте в примере, что хотите получить на выходе. Тогда, возможно, и код появится.
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Владимир,
где то так
 
Цитата
наименования товаров подгрупп товаров: БББ, ГГГ, БББ
А, если будут переноситься наименования товаров подгрупп товаров: БББ, БББ, ГГГ ?
 
Kuzmich,
думаю можно попробовать, потом дописать - удалить что не нужно
 
Цитата
удалить что не нужно
Вам нужно и БББ и ГГГ, я спрашиваю, можно ли изменить порядок копирования, т.к. групп БББ у вас две?
 
Надо добавить слева колонку и пройтись макросом по названию подгрупп (В данном случае проверка на полужирность шрифта можно использовать) потом нажать кнопку ну или сделать одним макросом.
 
Цитата
Kuzmich написал:
А, если будут переноситься наименования товаров подгрупп товаров: БББ, БББ, ГГГ ?
прошу прощения был не внимателен
БББ, БББ, ГГГ - это вообще в идеале
 
Дмитрий Тарковский,
благодарю за Ваш вариант
немного не то, но есть над чем подумать
идея с жирным шрифтом понравилась буду тестировать с исходником
 
Цитата
БББ, БББ, ГГГ - это вообще в идеале
Для подгрупп "подгруппа товаров БББ", "подгруппа товаров ГГГ"
Код
ub Groups()
Dim FRow As Integer
Dim ERow As Integer
Dim FoundCell As Range
Dim FAdr As String
Dim LastRow As Long
Dim i As Integer
Dim LR As Long
Dim arr
  LastRow = Cells(Rows.Count, 1).End(xlUp).Row
  With Worksheets("НАДО ЛИСТ 2")
    LR = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("A2:F" & LR).ClearContents
    arr = Array("подгруппа товаров БББ", "подгруппа товаров ГГГ")
  For i = 0 To UBound(arr)
    Set FoundCell = Columns("C:D").Find(arr(i), , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
        FAdr = FoundCell.Address
      Do
        FRow = FoundCell.Row + 1
        ERow = Cells(FRow, "A").End(xlDown).Row
         If ERow = LastRow Then ERow = LastRow - 1
          LR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
          Range("C" & FRow & ":C" & ERow).Copy .Cells(LR, "A")
          Range("E" & FRow & ":E" & ERow).Copy .Cells(LR, "B")
          Range("I" & FRow & ":I" & ERow).Copy .Cells(LR, "C")
          Range("J" & FRow & ":J" & ERow).Copy .Cells(LR, "D")
          Range("K" & FRow & ":K" & ERow).Copy .Cells(LR, "E")
          Range("L" & FRow & ":L" & ERow).Copy .Cells(LR, "F")
          Set FoundCell = Columns("C:D").FindNext(FoundCell)
      Loop While FoundCell.Address <> FAdr
     End If
  Next
  End With
End Sub
 
Kuzmich,
Прекрасно!!! просто нет слов!!! большое спасибо!!!
не будет ли слишком нагло с моей стороны попросить добавить код выборки данных с конкретного листа, а не с открытого, пожалуйста)
заранее благодарю
 
Цитата
код выборки данных с конкретного листа, а не с открытого
На этом конкретном листе сделайте кнопку и к ней привяжите макрос
 
Kuzmich,
Благодарю!!! хорошего дня!
 
Kuzmich,
доброго времени суток
прошу прощения за назойливость, но возникла проблема, в случае если в подгруппе всего одно наименование, подхватываются имя подгруппы
в примере - подгруппа товаров ДДД
 
Цитата
возникла проблема, в случае если в подгруппе всего одно наименование
Добавьте в код недостающие строки
Код
      Do
        FRow = FoundCell.Row + 1
        If Not IsEmpty(Cells(FRow + 1, "A")) Then
          ERow = Cells(FRow, "A").End(xlDown).Row
        Else
          ERow = FRow
        End If

 
Kuzmich,
Благодарю
 
В продолжении темы
как в строке макроса выше
Код
arr = Array("подгруппа товаров БББ", "подгруппа товаров ГГГ")
имена ("подгруппа товаров БББ", "подгруппа товаров ГГГ") задать переменными
например
х1 = А1; х2 = А2; х3 = А3; ... ; х10 = А10 (где в ячейках А1 - А10 названия подгрупп)
ну и на выходе должно получиться что то вроде
Код
arr = Array(x1, x2, x3, ..., x10)
 
Цитата
имена ("подгруппа товаров БББ", "подгруппа товаров ГГГ") задать переменными
Код
arr = Array(Range("A1"), Range("A2"))
Изменено: Kuzmich - 04.08.2017 13:11:14
Страницы: 1
Наверх