Многоуровневая группировка строк
Если у вас имеется большая и сложная таблица на небольшом мониторе (например, ноутбука), то в процессе работы с ней часто возникает желание скрыть часть ненужных в текущий момент данных (строк или столбцов). Основные способы для решения этой проблемы - скрытие строк и группировка. Вот о последнем способе и пойдет речь далее.
Предположим, что мы работаем вот с такой сложной многоуровневой таблицей с данными:
Обратите внимание на то, что в таблице ясно и четко прослеживаются вложенные друг в друга уровни данных. Такую структуру часто можно увидеть в:
- бюджетировании - статьи доходов/расходов группируются в блоки (cost centers) или по географическому признаку (страна-край-город)
- управлении проектами - этапы проектов разбиты обычно на более мелкие подзадачи и действия
- строительных сметах - похожим образом обычно расписываются расчеты расхода материалов и их стоимости при строительстве
- и т.д. - дальше придумайте сами.
Делать такую группировку вручную весьма мучительно, вследствие неудобности и ограниченности средств группировки самого Excel. Поэтому, столкнувшись как-то с подобной задачей в одном из своих проектов, я написал макрос для автоматической группировки подобных списков, которым и хочу тут поделиться. Чтобы применить его к вашему списку, проделайте следующие действия:
Нажмите сочетание клавиш ALT+F11, чтобы открыть редактор Visual Basic. В нем выберите в меню команду Insert - Module, чтобы вставить новый модуль и скопируйте туда текст макроса:
Sub Multilevel_Group()
Dim level As Single, i As Single
Dim start As Single, LastRow As Single
Const FIRST_ROW = 2 'первая строка списка
Const FIRST_COLUMN = 1 'первый столбец списка
Const NUMBER_OF_LEVELS = 3 'количество уровней
Set ws = ActiveSheet
ws.UsedRange.ClearOutline 'убираем все группировки на листе
LastRow = WorksheetFunction.Match("Конец", ws.Columns(FIRST_COLUMN), 0) 'определяем номер последней строки
'проходим во вложенном цикле по уровням и группируем
For level = 1 To NUMBER_OF_LEVELS
start = 0
For i = FIRST_ROW To LastRow
'если нашли начало группы - запоминаем номер строки
If ws.Cells(i, level+FIRST_COLUMN-1) <> "" And _
WorksheetFunction.CountA(ws.Cells(i + 1, FIRST_COLUMN).Resize(1, level)) = 0 Then start = i
'если нашли конец группы - группируем
If WorksheetFunction.CountA(ws.Cells(i + 1, FIRST_COLUMN).Resize(1, level)) > 0 And start > 0 Then
ws.Rows(start + 1 & ":" & i).Group
start = 0
End If
Next i
Next level
End Sub
При необходимости, текст можно слегка подкорректировать под ваши особенности, а именно изменить:
- FIRST_ROW - номер первой строки списка, начиная с которой пойдет группировка. Если у вас шапка не из одной строки или над таблицей есть данные - меняйте.
- FIRST_COLUMN - номер первого столбца списка, с которого начинается анализ и группировка. Если слева от вашей таблицы есть еще колонки, то эту константу также нужно изменить.
- NUMBER_OF_LEVELS - количество уровней (столбцов) для анализа. В приведенном выше примере мы хотим проанализировать три первых столбца, поэтому значение этой константы =3
Важно! Макрос предполагает, что:
- Уровни заполняются по порядку, т.е., например, уровень 3 не может быть написан, если ему не предшествовал уровень 2.
- В первом столбце списка в последней строке должно быть слово Конец, которое необходимо, чтобы макрос понял, где заканчивается список и пора остановиться:
Чтобы запустить добавленный макрос для списка на текущем листе, нажмите сочетание клавиш ALT+F8, выберите в списке наш макрос Multilevel_Group и нажмите кнопку Выполнить (Run).
Ссылки по теме
- Что такое макросы, как их создавать, куда копировать текст макроса на Visual Basic
- Скрытие/отображение ненужных строк и столбцов
Задаём только начало для блока группировки (столбец и строку) и ограничение в 16 уровней задал жестко.
Повешал на горячие клавиши.
Пользуйте, кому полезно будет..
У меня такое сработало. Не претендую на оптимальность.
Sub ЗаполнениеУровняГруппировки()
' Для ускорения работы макроса обновление экрана отключается.
Application.ScreenUpdating = False
Dim rr, i, c As Long
c = ActiveCell.Column
i = CLng(InputBox("введите номер первой строки для обработки?", "введите номер первой строки для обработки?", ActiveCell.Row))
rr = ActiveCell.UsedRange.Rows.Count
While i < rr
Cells(i, c).Value = ActiveSheet.Rows(i).OutlineLevel
i = i + 1
Wend
Application.ScreenUpdating = True
End Sub
Группировка в таком случае вообще возможна? Не макросом а вообще в принципе?
06.06.2013 |ААА|111| 5600р
07.06.2013 |ААА|222| 600р
07.06.2013 |БББ|111| 120р
07.06.2013 |БББ|555| 17800р
08.06.2013 |ВВВ|777| 1200р
09.06.2013 |ВВВ|777| 100р
И сгруппировать такое вполне можно стандартными средствами - с помощью Промежуточных итогов, например (Данные - Промежуточные итоги).
Есть ли способ обьединить две многоуровневые таблицы со сгруппированными данными в одну, по сути дополнить одну таблицу данными (целыми строками) из второй?
Неужели в Экселе стоит ограничение по количеству уровней группировки =8? если нет, то где-то это настраивается?
У меня есть отчет, в котором 11 уровней группировки, но после 8 уровня Эксель не дает больше создать и все нижние перегруппировывает в более высокий
Ваш макрос подходит просто идеально для моей задачи!
Признаюсь сразу: раньше этим не занималась. Теперь нужно
На все вопросы есть ответы. На форуме ли, в рубрике "ПРИЕМЫ" ли... Кому как, но мне кожется, самые доскональные ответы в "Видео". Когда сам видишь как, что, и за чем все происходит.
Не задумывались сделать и на эту тему обучающий видео урок?
Спасибо
Столбец по которому хотел сделать выглядит вот так:
№№ п/п
1
1.1
1.1.1
1.1.2
1.1.3
1.1.3.1
1.1.4
и т.д
Макрос очень помог, только почему-то не группирует последние строки группу!
Подскажите в чем причина?
Нужно изменить настройки группировки во вкладке данные --> группировка. Или добавить это в начале кода:
With ActiveSheet.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlLeft
End With
Selection.ApplyOutlineStyles
1
1.1
1.2
1.3
2
2.1
2.2
2.2.1
2.2.2
2.2.2.1
2.2.2.2
2.2.3
2.3
3
И тд. ???
Sub GroupByDot() On Error Resume Next firstrow = Application.InputBox("Первая строка списка", Type:=1) If firstrow = False Then Exit Sub lvlcol = Application.InputBox("Номер столбца, куда попадает уровень", Type:=1) If lvlcol = False Then Exit Sub ActiveSheet.UsedRange.ClearOutline 'макрос который определяет уровень k = firstrow Do Until Cells(k, 1) = "" strt = Cells(k, 1) l = Len(strt) l1 = 1 h = 1 Do Until l1 = l + 1 strt1 = Mid(strt, l1, 1) If strt1 = "." Then h = h + 1 End If l1 = l1 + 1 Loop Cells(k, lvlcol) = h k = k + 1 Loop'макрос который делает уровни e = firstrow Do Until Cells(e, 1) = "" If Cells(e, lvlcol).Value >= 0 Then For i = 1 To Cells(e, lvlcol) Rows(e).Group 'Cells(e, 1).InsertIndent 1 Next i If Cells(e, lvlcol).Value < Cells(e + 1, lvlcol).Value And Cells(e + 1, lvlcol) <> "" Then Range(Cells(e, 1), Cells(e, 7)).Font.Bold = True End If e = e + 1 Loop ActiveSheet.Outline.SummaryRow = xlAbove ActiveSheet.Outline.SummaryColumn = xlRight End SubМакрос работает. Но можно ли его так изменить, что бы он не проставлял уровни, в столбце числами, а смотрел их по какому-то столбцу умной таблицы, у меня автоматом уровни определяются 1.1, 1,2 (формулой). Таблица-шаблон, и уровни меняются.
Возможно сделать оглавление по листу!
в Worde это легко сделать а здесь не разобрался!
Что бы потом конвертировать в PDF с навигацией!
Навигация нужна по Группе.
Пример:
Const FIRST_ROW = 2 'первая строка списка (оставляю без изменений)
Const FIRST_COLUMN = 1 'первый столбец списка (меняю на 4 - колонка транспортный код)
Const NUMBER_OF_LEVELS = 3 'количество уровней (меняю на 1 )
Если верно понимаю, то должна произойти группировка только по 4 колонке. НО НИЧЕГО НЕ ПРОИСХОДИТ. Может кто подскажет. Спасибо заранее.