Макрос на группировку excel

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

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

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

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).

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

  • Что такое макросы, как их создавать, куда копировать текст макроса на Visual Basic
  • Скрытие/отображение ненужных строк и столбцов

0 / 0 / 0

Регистрация: 25.04.2006

Сообщений: 5

1

25.04.2006, 19:11. Показов 56936. Ответов 25


Студворк — интернет-сервис помощи студентам

Помогите, пожалуйста, я так устала вручную группировать строки. Как написать макрос, чтобы в таблице EXCEL строки автоматом группировались по одинаковым названиям в первом столбце. Т.е. сбоку слева появлялся «плюсик» и можно было группу свернуть или развернуть.

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



0



3 / 3 / 0

Регистрация: 08.09.2011

Сообщений: 111

25.04.2006, 20:27

2

А нужен ли макрос, если есть встроенный инструмент?
Data -> Subtotals… далее по инструкции….



0



0 / 0 / 0

Регистрация: 25.04.2006

Сообщений: 5

25.04.2006, 20:37

 [ТС]

3

Спасибо буду искать, что это такое Если у ВАс есть возможность можно чуть подробнее…



0



3 / 3 / 0

Регистрация: 08.09.2011

Сообщений: 111

25.04.2006, 20:53

4

По-русски это называется консолидация…
Вот здесь можно почитать:

http://www.firststeps.ru/
— MS Office
— Шаг 65 — Попробуем консолидацию



0



5 / 5 / 3

Регистрация: 17.10.2007

Сообщений: 1,119

25.04.2006, 21:03

5

lullul,

Vi mozhete poprobovat’ sovet Tsveta. Vot vam esche odin: idite v menu [bold]Data/Pivot Table[/bold] …
V techenie 20 sekund sdelal vashu zadachu metodom Drag and Drop…

vladconn



0



0 / 0 / 0

Регистрация: 25.04.2006

Сообщений: 5

25.04.2006, 21:34

 [ТС]

6

Про консолидацию прочитала спасибо, но мне не надо сумировать и т.д. Мне надо просто огромную таблицу привести в более сжатый вид. Одинаковые позиции по первому столбцу сгруппировать так, чтобы сбоку слева появлялся «плюсик» и можно было группу свернуть или развернуть. Чтобы клиент мог сначала выбрать нужную группу в списке и только затем с помощью плюсика её развернуть и искать подробнее что ему надо.

Я это обычно делаю в ручную с помощью меню Данные-группа и структура-группировать. Очень хочу эту процедуру автоматизировать



0



5 / 5 / 3

Регистрация: 17.10.2007

Сообщений: 1,119

25.04.2006, 22:01

7

lullul,

Esche variant:

MSHFLEXGRID i OLEDB data control!

MSHFLEXGRID kak raz dlya vashej zadachi.

vladconn



0



0 / 0 / 0

Регистрация: 25.04.2006

Сообщений: 5

25.04.2006, 22:20

 [ТС]

8

Всем спасибо, буду стараться



0



VladConn

5 / 5 / 3

Регистрация: 17.10.2007

Сообщений: 1,119

25.04.2006, 22:23

9

A, chto-to vrode etogo:

Visual Basic
1
2
3
4
5
6
7
8
Sub Macro1()
 
    Range("A2:C5").Select 'tkan', vid tkani, kol-vo
    Selection.Rows.Group
    Range("A7:C9").Select 'Kamen', nazvanie kamnya, kol-vo
    Selection.Rows.Group
 
End Sub

vladconn



0



Masalov

22 / 5 / 1

Регистрация: 05.09.2010

Сообщений: 370

26.04.2006, 10:41

10

Выделить ту часть листа где необходима массовая группировка и выполнить макрос:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Группировка()
  ' вначале выдели строки для массовой группировки
  x = 1 ' номер колонки
  Dim rng As Range
  Set rng = Selection.EntireRow
  y = rng.Row
  yend = y + rng.Rows.Count - 1
  mes = "Выполнить массовую группировку" & vbCr & _
      "со строки " & y & " по строку " & yend & "?"
  If MsgBox(mes, vbQuestion + vbOKCancel, "") = vbCancel Then End
  ybeg = y
  ActiveSheet.Outline.SummaryRow = xlAbove
  For y = y To yend
    If Cells(y, x) <> Cells(y + 1, x) _
    Or y = yend Then
      If ybeg + 1 <= y Then Rows(ybeg + 1 & ":" & y).Rows.Group
      ybeg = y + 1
    End If
  Next
  MsgBox "Готово", vbInformation, ""
End Sub



0



rank1

30.04.2006, 23:30

11

У меня тут возникла сходная задачка — нужно было в зависимости от уровня группы в колонке группировать строки. Первое что пришло в голову:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Option Explicit
Sub grp() 'Группировка
 On Error GoTo errH
 Dim h: Set h = New Scripting.dictionary
 Dim x As Range
 Set x = Selection.EntireColumn.Cells.SpecialCells(xlCellTypeConstants)
    Dim i As Long, j As Long, c As Range
    For i = 1 To 10
      For Each c In x.Cells
         c.Select
         For j = i To 10
            DoEvents
            If c.Value = j Then
                 If IsEmpty(h(i)) Then
                    Set h(i) = c
                 Else
                    Set h(i) = Union(h(i), c)
                 End If
            End If
         Next j
      Next c
    Next i
 Dim k
 Dim a As Range
 For Each k In h.Keys
  For Each a In h(k).Areas
   DoEvents
   a.Rows.Group
  Next a
 Next k
 If 0 Then
errH:
   MsgBox Err.Description
 End If
 Set h = Nothing
End Sub
Sub ugp() 'Разгруппировка
On Error Resume Next
   Rows.Ungroup
   Rows.Ungroup
   Rows.Ungroup
   Rows.Ungroup
   Rows.Ungroup
   Rows.Ungroup
   Rows.Ungroup
   Rows.Ungroup
End Sub

rank1

30.04.2006, 23:31

12

Для работы необходимо подключить scrrun.dll — для Dictionary

rank1

30.04.2006, 23:33

13

…и курсор должен стоять в той колонке где уровни вложенности указаны.

Сумрак

01.05.2006, 22:11

14

Сначала отсортировать придется для группировки…

22 / 5 / 1

Регистрация: 05.09.2010

Сообщений: 370

02.05.2006, 11:11

15

Здесь еще пример группировки, но по номерам параграфа…

http://relib.com/forums/Topic846792-11-1.aspx



0



0 / 0 / 0

Регистрация: 21.02.2014

Сообщений: 14

21.02.2014, 15:24

16

Доброго дня! Мне нужен макрос чтобы из разноцветных строк группировал только бесцветные. Кто-нибудь может мне помочь в этом.



0



15136 / 6410 / 1730

Регистрация: 24.09.2011

Сообщений: 9,999

21.02.2014, 15:31

17

Артем 1981, приложите пример.



1



0 / 0 / 0

Регистрация: 21.02.2014

Сообщений: 14

03.04.2014, 12:50

18

Приложил пример (2 вкладки). Макрос должен делать из таблицы во вкладке «до», таблицу такую как во вкладке «после», то есть группировать только строки без выделения цветом.



0



15136 / 6410 / 1730

Регистрация: 24.09.2011

Сообщений: 9,999

03.04.2014, 13:41

19

Артем 1981, почему группировка «вниз»? Строки 8,9 вроде относятся к 7?



0



0 / 0 / 0

Регистрация: 21.02.2014

Сообщений: 14

03.04.2014, 14:48

20

Да совершенно верно п.8,9 относятся к п.7, это у меня просто настройка такая.



0



Regarding rows not in pivot tables … It has NOT been my experience in Excel 2010 that ShowDetail ALWAYS evaluates to True. I thought it did but I didn’t realize that I needed to be on the summary row for this property to work as expected. Second of all, I didn’t realize the summary row by default is UNDER the grouped rows. Testing for collapsed/expanded became much clearer once I changed that setting to have the summary row above the grouped rows (in the Ribbon: Data > Outline, Show the Outline Dlg Box).

If my selected cell is on the summary row, the ShowDetail evalutes to True if the grouped records are showing, and to False if they are not. The key for me was being on the summary row to see that behavior work this way. Having the child/grouped rows above by default really threw me.

Here’s my macro, which dynamically expands and collapses the grouped records tied to the summary row when I select a cell on a summary row. And, it makes my cell in column A bold if the section is expanded. This macro does not run if I’ve selected more than one cell.

Note that worksheet protection prevents expanding and collapsing groups of cells. My worksheet is protected, so I unprotect the sheets to expand/collapse then reprotect them after. (A possible improvement would be for me to just unprotect/protect just the current sheet instead of all of them.)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'TOGGLE SHOW/HIDE ROW
If Target.Cells.Count = 1 Then
    If (Target.EntireRow.OutlineLevel = 1) And (Target.Offset(1, 0).EntireRow.OutlineLevel = 2) And _
       (Target.Column < 15) Then
            Call Macros.ProtShts(False)
                Target.EntireRow.ShowDetail = Not Target.EntireRow.ShowDetail
                If Target.EntireRow.ShowDetail = True Then
                    Range(Cells(Target.Row, 1), Cells(Target.Row, 14)).Font.Bold = True
                Else
                    Range(Cells(Target.Row, 1), Cells(Target.Row, 14)).Font.Bold = False
                End If
            Call Macros.ProtShts(True)
    End If
End If
End Sub

Remember, I set my summary row to be above the grouped records. If your summary row is below the grouped records (the default) then the offset row reference must be changed to -1, like this:

(Target.Offset(1, 0).EntireRow.OutlineLevel = 2)

Добрый день!

Прошу помочь с написанием макроса, который бы работал следующим образом:

0. На листе создается кнопка «Группировка», которая активирует макрос, при нажатии на нее; кнопка «Сгруппировать», которая группирует все существующие связи; «Разгруппировать», которая разгруппирует их, соответственно.

При нажатии на кнопку «Группировка», происходят следующие процессы:
1. Сбрасываются (удаляются) все действующие группировки на листе;
2. Определяется диапазон работы макроса — со строки № 6 листа (включительно), до строки, в столбце В которой значение «Общий итог» (номер строки не определен!!);
3. Группируются строки, в столбце А которых стоит значение «-«, разумеется каждый набор последовательно идущих строк, удовлетворяющих условие, группируется отдельно, «не задевая» те строки, которые условие не удовлетворяют.

ПС. Если есть вариант решения задачи не макросом, а иным способом — то будет вообще супер!

Пример прилагаю. Благодарю за уделенное время!

Макрос для группировки/разгруппировки столбцов

Автор laska1983, 16.11.2009, 22:00

« назад — далее »

Добрый вечер!
У меня такая проблема.
Как написать макрос для группировки столбцов, отмеченных каким-нибудь символом!
При этом нужно, чтобы макрос, как группировал столбцы, так и открывал их.
Видела вариант, когда столбца просто скрываются, но это мне не подходит.

Пожалуйста, помогите!!!


ThisWorkbook.ActiveSheet.ShowAllData       ‘отобразить все данные
ThisWorkbook.ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1 ‘сорачивание сгруппированного диапазона до 1-го уровня (строки/колонки)

Ничто не обходится нам так дешево и не ценится так дорого, как вежливость…  Мигель Сервантес де Сааведра


Спасибо!
А можно весь текст макроса,а…
пожалуйста…


а Вы пробовали макрорекодер?

Ничто не обходится нам так дешево и не ценится так дорого, как вежливость…  Мигель Сервантес де Сааведра


Знания недостаточно, необходимо применение. Желания недостаточно, необходимо действие. (с) Брюс Ли


Пробовала, но, видимо, программирование-не мой конек…а начальница хочет видеть макрос…:*(


Видела!
но мне хочется именно через функции, как мне уже показали….


О каких функциях вы говорите?
Представленный макрос использует Данные -> Группа и структура -> Группировка указанное в ячейках количество раз.

Знания недостаточно, необходимо применение. Желания недостаточно, необходимо действие. (с) Брюс Ли


хотела бы использовать вот эти…
ThisWorkbook.ActiveSheet.ShowAllData       ‘отобразить все данные
ThisWorkbook.ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1 ‘сорачивание сгруппированного диапазона до 1-го уровня (строки/колонки)


ThisWorkbook.ActiveSheet.ShowAllData       ‘отобразить все данные
используется если на листе есть фильтры
а без фильтров, — пример во вложении

Ничто не обходится нам так дешево и не ценится так дорого, как вежливость…  Мигель Сервантес де Сааведра


Цитата: boa от 16.11.2009, 23:23
а Вы пробовали макрорекодер?

Точно, в 2007-м Excel группировка выглядит иначе: подправил код, предназначенный для 2003-го. Лишним-то всяко не будет, раз уж есть. :)

Знания недостаточно, необходимо применение. Желания недостаточно, необходимо действие. (с) Брюс Ли


Спасибо всем большое за помощь!


  • Профессиональные приемы работы в Microsoft Excel

  • Обмен опытом

  • Microsoft Excel

  • Макрос для группировки/разгруппировки столбцов

Понравилась статья? Поделить с друзьями:
  • Макрос на выделение строк в excel
  • Макрос на вставку текста word
  • Макрос на вставку текста excel
  • Макрос для удаления листа excel
  • Макрос для удаления картинок в excel