Страницы: 1
RSS
Группировка (создание структуры) по определенным значениям VBA.
 
Доброго времени суток.

Столкнулся со следующей задачей: требуется с помощью макроса сгруппировать строки в обновляемой сводной таблице.
Количество строк постоянно меняется, группы всегда 3 (группа 1, группа 2, без группы).
Хочется применить именно структуру. Группировка самой сводной таблицы ("+") не подходит.

Честно изучил много вопросов по данной теме. Ответа, к сожалению, самостоятельно не нашёл.
Пример прикладываю.
 
Так вам нужны итоги по группам или группировка строк по группам?
 
Цитата
Snaff написал:
Хочется применить именно структуру
Так что группировка с промежуточными итогами не устраивает? Она же получается точно такая как и на листе "Как нужно видеть". На листе "Исходные данные" данные сделал пром итоги (На ленте Данные--Структура--Промежуточные итоги)
Изменено: gling - 29.05.2017 12:30:43
 
Дорожный, Группировка строк по группам.
Итоги по группах мне уже даёт сводная таблица.

Технически вручную это выглядит так: я выделяю строки с каждой группой и группирую через Данные-Группировка.
Изменено: Snaff - 29.05.2017 12:39:33
 
gling, спасибо за ответ.

Нужно решение в виде макроса vba.
Технически, опять же, я вижу порядок действий такой:

- Поиск строк о значением "1 группа"
- Выделение этих строк
- группировка

- Поиск строк о значением "2 группа"
- Выделение этих строк
- группировка

- Поиск строк о значением "Без группы"
- Выделение этих строк
- группировка
 
Цитата
Snaff написал:
Нужно решение в виде макроса vba.
Включите запись макроса макрорекордером --Выделите весь диапазон -- сортировка по столбцу А-- На вкладке данные, структура--ПромИтоги--Выключайте запись макроса. При необходимости подкорректируйте, в плане диапазона (постоянный или выделенный) и вешайте на кнопку. Не так формируется? У меня получилось так
Код
Sub Макрос1()
'
' Макрос2 Макрос
'

'
    Range("A1:C10").Select
    ActiveWorkbook.Worksheets("Исходные данные").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Исходные данные").Sort.SortFields.Add Key:=Range( _
        "A2:A10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Исходные данные").Sort
        .SetRange Range("A1:C10")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub
Изменено: gling - 29.05.2017 12:58:54
 
gling, спасибо большое за ответ.

Данное решение не подходит, так как требуется сгруппировать строки ИМЕННО в сводной таблице, как было указано в моём первом сообщении.
Вкладка «исходные данные» носит справочный характер и к задаче относится косвенно.
 
Цитата
Snaff написал:
ИМЕННО в сводной таблице,
Раз так, тогда пробуйте макрос
Код
Sub Группировка()
Dim i As Long, Rw As Long
With Sheets("Сводная")
Rw = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Rw
If .Cells(i, 1) = .Cells(i + 1, 1) Or .Cells(i, 1) = .Cells(i - 1, 1) Then Rows(i).Rows.Group
Next
End With
End Sub
 
gling, спасибо Вам большое.

Макрос работает прекрасно.
 
gling, а в случае если в одной группе всего один артикул.
Он при этом пропускает данную группу. Как можно решить данный момент?

Пример прикладываю.
 
Может тогда такой подойдет?
Код
Sub Группировка()
Dim i As Long, Rw As Long
With Sheets("Сводная")
Rw = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Rw
If Application.CountIf(.Cells(i, 1), "*Итог*") = 0 Then Rows(i).Rows.Group
Next
End With
End Sub
 
gling, спасибо Вам большое за помощь.
Вынужден в очередной раз обратиться.

В случае, если мы также будем иметь в исходных данных помимо группы, еще и категорию.
Требуется группировать категории вторым уровнем структуры. Каким образом это можно осуществить?

Пример прикладываю.
 
не пойму почему макрос отказывается определять итоговые строчки по текстовым значением большого объема.
подскажите пожалуйста где я ошибаюсь

Dim i As Boolean, Rw As Boolean
With Sheets("Лист1")
Rw = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Rw
If .Cells(i, 1) = .Cells(i + 1, 1) Or .Cells(i, 1) = .Cells(i - 1, 1) Then Rows(i).Rows.Group
Next
End With
End Sub
Страницы: 1
Наверх