Многоуровневая группировка строк

110086 07.10.2012 Скачать пример

Если у вас имеется большая и сложная таблица на небольшом мониторе (например, ноутбука), то в процессе работы с ней часто возникает желание скрыть часть ненужных в текущий момент данных (строк или столбцов). Основные способы для решения этой проблемы - скрытие строк и группировка. Вот о последнем способе и пойдет речь далее.

Предположим, что мы работаем вот с такой сложной многоуровневой таблицей с данными:

group1.png

Обратите внимание на то, что в таблице ясно и четко прослеживаются вложенные друг в друга уровни данных. Такую структуру часто можно увидеть в:

  • бюджетировании - статьи доходов/расходов группируются в блоки (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.
  • В первом столбце списка в последней строке должно быть слово Конец, которое необходимо, чтобы макрос понял, где заканчивается список и пора остановиться:

group2.png

 

Чтобы запустить добавленный макрос для списка на текущем листе, нажмите сочетание клавиш ALT+F8, выберите в списке наш макрос Multilevel_Group и нажмите кнопку Выполнить (Run).

Ссылки по теме

 



Psiho
07.10.2012 10:52:04
FIRST_ROW, FIRST_COLUMN и NUMBER_OF_LEVELS, на мой взгляд, не стоит делать константами, а внести в параметры процедуры, чтобы пользователь при её вызове сам определял количество уровней группировки и размер шапки таблицы. Тогда процедура будет универсальной.
07.10.2012 10:55:04
Ну, это вопрос вкуса :)
Mary
07.10.2012 10:52:37
Написала аналогичный макрос года 2 назад. Забавно, что даже переменные у меня названы также:)
Александр
07.10.2012 10:54:07
Была проблема: уровни начинались и с 5го и с 7го. А заканчивались и 7 и 15м. Никаких ключевых слов и правил. Спасся вот такой рекурсией:
Function GroopBlock(Col_ As Integer, Str_ As Integer) As Integer
   Dim i As Integer
   Dim j As Integer
   i = 0
   While ActiveSheet.Cells(Str_ + i, Col_).Value <> ""
      If ActiveSheet.Cells(Str_ + i + 1, Col_).Value = "" Then
         For j = Col_ + 1 To 16
            If ActiveSheet.Cells(Str_ + i + 1, j).Value <> "" Then i = i + GroopBlock(j, Str_ + i + 1)
               Exit For
            End If
         Next j
      End If
     i = i + 1
 Wend
 Range(Cells(Str_, 1), Cells(Str_ + i - 1, 1)).EntireRow.Group
 GroopBlock = i
 End Function

Задаём только начало для блока группировки (столбец и строку) и ограничение в 16 уровней задал жестко.
Повешал на горячие клавиши.
Пользуйте, кому полезно будет..
22.04.2013 16:52:08
Господа, кто посоветует, как проанализировать готовый многоуровневый список? Т. е., в какой-то ячейке текущей строки, поставить значение уровня, к которому относится ячейка в текущей строке?
23.04.2013 18:32:55
Для примера - по первой иллюстрации в статье. Ввести в ячейку H2 формулу =ПОИСКПОЗ("*";A2:G2;0) и скопировать вниз до конца списка. Получите номер первой непустой ячейки с текстом в строке, т.е. уровень вложенности. Пойдет? :)
24.04.2013 10:37:25
Николай, спасибо за идею, однако для моего случая она не работает. В моем списке все сгруппированные по разным уровням данные находятся в первой колонке. Т.е. группировка есть, а сдвижки по колонкам, в зависимости от уровня - нет!. Вот такая бедулька ....
09.02.2015 13:44:30
Добрый день!

У меня такое сработало. Не претендую на оптимальность.

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
07.05.2013 11:51:47
А как можно структурировать такого вида конструкции:
Группировка в таком случае вообще возможна? Не макросом а вообще в принципе?
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р
07.05.2013 23:08:40
Если вы имеете ввиду группировку по ААА и БББ и ВВВ, то вам, как минимум, нужно иметь пустые строки между 2 и 3, 4 и 5 строками - иначе три группировки сольются в одну.
И сгруппировать такое вполне можно стандартными средствами - с помощью Промежуточных итогов, например (Данные - Промежуточные итоги).
15.05.2013 14:44:08
Просто, пришёл на новое место где уже "устоялся" данный стиль записи а промежуточные считают вручную, но хочется не тратить время на рутину и заставить всё это делать компьютер, максимально безболезненно для рабочего процесса.
15.05.2013 14:45:20
Все правильно. Итоги вручную считать - это прошлый век. Вы им еще сводные таблицы покажите - сойдут с ума от радости ;)
25.07.2013 21:50:11
Здравствуйте, у меня вопрос не по макросу, но по группировке.
Есть ли способ обьединить две многоуровневые таблицы со сгруппированными данными в одну, по сути дополнить одну таблицу данными (целыми строками) из второй?
10.04.2015 13:10:01
Добрый день. Подскажите пожалуйста как изменить макрос для группировки структуры в примере ниже.
округСервис 1Фио 61
округСервис 1Фио 743
округСервис 1 итого44
округСервис 2Фио 113
округСервис 2Фио 218
округСервис 2Фио 39
округСервис 2Фио 43
округСервис 2 итогоФио 53
округ итого134
округ 1Сервис 3Фио 113
округ 1Сервис 3Фио 218
округ 1Сервис 3Фио 39
округ 1Сервис 3Фио 43
округ 1Сервис 3 итогоФио 53
округ 1 итого46
Общий итог180
09.09.2015 16:48:59
Николай, добрый день!

Неужели в Экселе стоит ограничение по количеству уровней группировки =8? если нет, то где-то это настраивается?
У меня есть отчет, в котором 11 уровней группировки, но после 8 уровня Эксель не дает больше создать и все нижние перегруппировывает в более высокий
09.09.2015 17:24:01
Светлана, насколько я знаю, 8 уровней - это предел в любой версии Excel и поменять это ограничение нельзя :(
24.09.2015 16:39:09
Николай, а можно ли сделать группировку по цвету? У Вас в примере каждый уровень выделен определенным цветом. Тогда можно было бы группировать без смещения.
30.10.2015 16:02:43
    День добрый, Николай!
Ваш макрос подходит просто идеально для моей задачи!
Признаюсь сразу: раньше этим не занималась. Теперь нужно :)  Вчера освоила написание простых макросов. Хотела ваш просто скопировать в свой лист, убрав зеленый текст. Когда пробую применить его в работу пишет следующую ошибку: "Run-time error '1004': Невозможно получить свойство Match класса WorksheetFunction" . Подскажите, в чем причина?  
06.12.2018 16:45:47
Та же проблема была вместо LastRow = WorksheetFunction.Match("Конец", ws.Columns(FIRST_COLUMN), 0) задайте  LastRow = (точное количество строк) и проблема исчезнет, у меня просто был список с более 1 млн. строк, так сказать максимум возможности по строчкам excel использованы)
09.12.2015 04:53:28
Доброго времени суток, Николай!
На все вопросы есть ответы. На форуме ли, в рубрике "ПРИЕМЫ" ли... Кому как, но мне кожется, самые доскональные ответы в "Видео". Когда сам видишь как, что, и за чем все происходит.
Не задумывались сделать и на эту тему обучающий видео урок?
Спасибо
10.12.2015 11:10:27
Здравствуйте. Очень понравилась статья. У меня вопрос, можно ли сделать автоматическую группировку с помощью макроса не разбивая по столбцам.
Столбец по которому хотел сделать выглядит вот так:

№№ п/п
1
1.1
1.1.1
1.1.2
1.1.3
1.1.3.1
1.1.4
и т.д
19.12.2015 16:36:27
Здравствуйте!
Макрос очень помог, только почему-то не группирует последние строки  группу!
Подскажите в чем причина?
06.02.2017 09:58:18
Екатерина,

Нужно изменить настройки группировки во вкладке данные --> группировка. Или добавить это в начале кода:


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
И тд. ???
04.07.2016 12:53:15
 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
15.09.2016 16:06:44
Здравствуйте. Подскажите, возможно в макросе учесть группировку по цвету и критерий отбора не по разным столбцам, а с учетом одного столбца?
24.12.2016 03:00:13

Artyom Avakyan
Макрос работает. Но можно ли его так изменить, что бы он не проставлял уровни, в столбце числами, а смотрел их по какому-то столбцу умной таблицы, у меня автоматом уровни определяются 1.1, 1,2 (формулой). Таблица-шаблон, и уровни меняются.  
24.01.2017 23:26:34
:( Совсем никто не может подсказать?
10.02.2017 14:19:24
Добрый день, а можно ли сделать группировку по датам (суткам), таблицы такого вида:


05.04.17 7:00    0,00187756   
05.04.17 8:00    0,00190244   
05.04.17 9:00    0,00192732   
05.04.17 10:00    0,00195220   
05.04.17 11:00    0,00197708   
05.04.17 12:00    0,00000196   
05.04.17 13:00    0,00002984   
05.04.17 14:00    0,00005772   
05.04.17 15:00    0,00008560   
05.04.17 16:00    0,00011348   
05.04.17 17:00    0,00014136   
05.04.17 18:00    0,00016924   
05.04.17 19:00    0,00019712   
05.04.17 20:00    0,00022500   
05.04.17 21:00    0,00025288   
05.04.17 22:00    0,00028076   
05.04.17 23:00    0,00030864   
06.04.17 0:00    0,00033652   
06.04.17 1:00    0,00036440   
06.04.17 2:00    0,00039228   
06.04.17 3:00    0,00042016   
06.04.17 4:00    0,00044804   
06.04.17 5:00    0,00047592   
06.04.17 6:00    0,00050380   
06.04.17 7:00    0,00053168   
а то выматывает постоянно туда-сюда елозить мышкой
:)
26.12.2018 22:48:26
По датам лучше всего создать сводную таблицу и там групировать хоть по дням, хоть по неделям и с любим шагом
;)
10.09.2018 02:03:07
Здравствуйте! Давно пользуюсь, данным кодом, всё отлично работает спасибо! Так как мне пришлось изменить организацию своей таблице, код перестал работать, причина в том, что те ячейки, ранее были пустыми, в новой таблице имеют формулу (типо ="";), код, как я понял выявлял заполненные и пустые ячейки на этом основании выводил группировку, соответственно в моём новом случае пустые ячей, но с формулой.
10.10.2018 09:45:34
ДОБРЫЙ ДЕНЬ!
Возможно сделать оглавление по листу!
в Worde это легко сделать а здесь не разобрался!
Что бы потом конвертировать в PDF с навигацией!
Навигация нужна по Группе.
Добрый день. Всех с наступающим Новым Годом. Пытаюсь разобраться с многоуровневой группировкой строк, макрос что опубликован выше вроде подходит для решения моей задачи, но почему-то не получается, где моя ошибка?  
Пример:
Контрагент. Канал збутуСупервайзерТорговий представникТранспортный код
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaВерес Мария ВалерьевнаМузира Людмила Григорьевна1405
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
HoReCaКраськович Маргарита ВасильевнаЦаренко Андрей Сергеевич280
Строк около 25тыс., транспортный код (это разные адреса около 700 штук) не повторяются, следующая колонка, ее не видно это дата месяца.

Const FIRST_ROW = 2   'первая строка списка (оставляю без изменений)
Const FIRST_COLUMN = 1 'первый столбец списка (меняю на 4 - колонка транспортный код)
Const NUMBER_OF_LEVELS = 3  'количество уровней (меняю на 1 )

Если верно понимаю, то должна произойти группировка только по 4 колонке. НО НИЧЕГО НЕ ПРОИСХОДИТ. Может кто подскажет. Спасибо заранее.
Наверх