Excel vba разгруппировать все - Word и Excel - помощь в работе с программами

Li$$@

Пользователь

Сообщений: 152
Регистрация: 31.01.2013

26.12.2013 08:44:28

Всем доброго утра!

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

Код

On Error Resume Next

Worksheets(1).Rows.Ungroup
Worksheets(1).Rows.Ungroup
Worksheets(1).Rows.Ungroup
Worksheets(1).Rows.Ungroup
Worksheets(1).Rows.Ungroup
Worksheets(1).Rows.Ungroup
Worksheets(1).Rows.Ungroup

Worksheets(1).Columns.Ungroup
Worksheets(1).Columns.Ungroup
Worksheets(1).Columns.Ungroup
Worksheets(1).Columns.Ungroup
Worksheets(1).Columns.Ungroup
Worksheets(1).Columns.Ungroup
Worksheets(1).Columns.Ungroup

On Error GoTo 0

В полете голова — важнее крыльев

anvg

Пользователь

Сообщений: 11878
Регистрация: 22.12.2012

Excel 2016, 365

26.12.2013 08:59:14

Добрый день. Попробуйте

Код
ActiveSheet.Cells.ClearOutline

С наступающим.

Li$$@ Пользователь Сообщений: 152 Регистрация: 31.01.2013	anvg , спасибо огромное! Проще простого оказывается В полете голова — важнее крыльев

Сбитый Лётчик Небосводов

Пользователь

Сообщений: 16
Регистрация: 18.10.2021

12.12.2021 22:30:41

Цитата
написал: ActiveSheet.Cells.ClearOutline

Помогло, спасибо.
И Вас с наступающим. И заодно с восемью наступившими.

Источник

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)

Источник

Перебрать сгруппированные ячейки и разгруппировать их

Alex_ST

Дата: Вторник, 30.10.2012, 15:42 |
Сообщение № 1

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176

Репутация:
604
±

Замечаний:
0% ±

2003

Народ,
помогите, пожалуйста, «затык настиг» biggrin
Попросили меня написать макрос, который переберёт по очереди все сгруппированные ячейки в выделенном диапазоне и про каждую из них спросить юзверга: «Разргуппировать или нет?»
Написал я с ходу такую фигню:[vba]

Code

Sub FindMergeCells()   ‘  перебрать все сгруппированные ячейки в выделенном диапазоне и предложить пользователю их разгруппировать
      If TypeName(Selection) <> «Range» Then Exit Sub
      If Selection.Cells.Count <= 1 Then Exit Sub
      Dim rCell As Range
      For Each rCell In Intersect(Selection, ActiveSheet.UsedRange)
         If rCell.MergeCells Then
            rCell.Select
            If MsgBox(«Разгруппировать ячейку?», vbYesNo) = vbYes Then rCell.UnMerge
         End If
      Next rCell
End Sub

[/vba]
Когда пользователь соглашается разгруппировать указанную ему сгруппированную ячейку, то всё отлично.
А вот если он откажется, то по очереди перебираются все скрытые под группировкой ячейки и про них задаётся вопрос.
Это, конечно, как борьба со злом с методологической точки зрения правильно: может быть, всё-таки устанет отказываться и согласится разгруппировать… Но по отношению к юзеру как-то не хорошо получается biggrin

С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_ST — Вторник, 30.10.2012, 15:49

Ответить

Формуляр

Дата: Вторник, 30.10.2012, 15:58 |
Сообщение № 2

Группа: Друзья

Ранг: Ветеран

Сообщений: 832

Репутация:
255
±

Замечаний:
0% ±

Excel 2003, 2013

Попробуй запоминать MergeArea:
[vba]

Code

    For Each rCell In Intersect(Selection, ActiveSheet.UsedRange)
          If rCell.MergeCells and Intersect(rCell, LastMergeArea) is nothing Then
              set LastMergeArea = rCell.MergeArea
              rCell.Select
              If MsgBox(«Разгруппировать ячейку?», vbYesNo) = vbYes Then rCell.UnMerge
          End If
      Next rCell

[/vba]

Excel 2003 EN, 2013 EN

Ответить

Alex_ST

Дата: Вторник, 30.10.2012, 16:08 |
Сообщение № 3

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176

Репутация:
604
±

Замечаний:
0% ±

2003

Спасибо, Саня.
Я уже и сам до точно такого же решения доковырялся.
Вот только при первом проходе LastMergeArea = Nothing и, естественно, Intersect(rCell, LastMergeArea) даёт ошибку. sad
Я пока сделал тупо: перед циклом назначенил равным первой ячейке выделения:[vba]

Code

Sub FindMergeCells()   ‘ перебрать все сгруппированные ячейки в выделенном диапазоне и предложить пользователю их разгруппировать
        If TypeName(Selection) <> «Range» Then Exit Sub
        If Selection.Cells.Count <= 1 Then Exit Sub
        Dim rCell As Range, rMergeArea As Range
        Set rMergeArea = Intersect(Selection, ActiveSheet.UsedRange)(1)
        For Each rCell In Intersect(Selection, ActiveSheet.UsedRange)
           If rCell.MergeCells And Intersect(rCell, rMergeArea) Is Nothing Then
              Set rMergeArea = rCell.MergeArea
              rCell.Select
              If MsgBox(«Разгруппировать ячейку?», vbYesNo) = vbYes Then rCell.UnMerge
           End If
        Next rCell
End Sub

[/vba] Но не красиво получается. Хоть и работает, но мне не нравится

С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_ST — Вторник, 30.10.2012, 16:10

Ответить

Формуляр

Дата: Вторник, 30.10.2012, 16:43 |
Сообщение № 4

Группа: Друзья

Ранг: Ветеран

Сообщений: 832

Репутация:
255
±

Замечаний:
0% ±

Excel 2003, 2013

Ну, с этим сложно бороться, разве что упростить исходную установку:
[vba]

Code

Set rMergeArea = [A1]

[/vba]
Кстати, для эстетов smile , вместо
[vba]

Code

If TypeName(Selection) <> «Range» Then Exit Sub

[/vba]красивше
[vba]

Code

If not TypeOf Selection Is Range Then Exit Sub

[/vba]

Excel 2003 EN, 2013 EN

Сообщение отредактировал Формуляр — Вторник, 30.10.2012, 16:45

Ответить

Alex_ST

Дата: Вторник, 30.10.2012, 16:59 |
Сообщение № 5

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176

Репутация:
604
±

Замечаний:
0% ±

2003

Ну, на вкус и цвет все фломастеры разные.
И по мне так красивше всё-таки [vba]

Code

If TypeName(Selection) <> «Range» Then Exit Sub

[/vba], тем более, что по количеству буковок почти однофигственно (у меня на 1 больше) tongue
——————
А по поводу [A1], так я, действительно перемудрил.

С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_ST — Вторник, 30.10.2012, 17:06

Ответить

Alex_ST

Дата: Вторник, 30.10.2012, 20:29 |
Сообщение № 6

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176

Репутация:
604
±

Замечаний:
0% ±

2003

Фигня какая-то получается: почему-то при отказе от разъединения ячеек выбор несколько раз прыгает с одной объединённой ячейки на другую.
При этом, похоже, правильно или нет срабатывает зависит от расположения на листе ячеек, попавших в Selection

Тестаните кто-нибудь примерчик, пожалуйста.

С уважением,
Алексей
MS Excel 2003 — the best!!!

Ответить

KuklP

Дата: Вторник, 30.10.2012, 20:52 |
Сообщение № 7

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация:
486
±

Замечаний:
0% ±

2003-2010

Нормально работает. Леш, я тут писал для unmerge однострочных ОЯ и выравнивания по центру выделения. Можно легко переделать:)
[vba]

Code

Public Sub UnMergeCells()
     Dim c As Range, s$, fA$
     Application.FindFormat.MergeCells = True
     With ActiveSheet.UsedRange
         Set c = .Find(«», [a1], xlFormulas, 2, SearchFormat:=True)
         If Not c Is Nothing Then
             fA = c.Address: Do
                 If UBound(c.MergeArea.Formula) = 1 Then
                     s = c.MergeArea.Address: c.UnMerge
                     Range(s).HorizontalAlignment = 7
                 End If
                 Set c = .Find(«», c, xlFormulas, 2, SearchFormat:=True)
             Loop While Not c Is Nothing And c.Address <> fA
         End If
     End With
End Sub

[/vba]

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

Pelena

Дата: Вторник, 30.10.2012, 20:57 |
Сообщение № 8

Группа: Админы

Ранг: Местный житель

Сообщений: 18797

Репутация:
4284
±

Замечаний:
±

Excel 2016 & Mac Excel

У меня начинает перепрыгивать, если выделены розовый и зеленый диапазон. У них есть общие (сквозные) строки

«Черт возьми, Холмс! Но как??!!»
Ю-money 41001765434816

Ответить

Alex_ST

Дата: Вторник, 30.10.2012, 20:57 |
Сообщение № 9

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176

Репутация:
604
±

Замечаний:
0% ±

2003

Привет, Серёга.
У тебя мой пример после выбора всего листа нормально работает? И по несколько раз одну и ту же ячейку не предлагает разгруппировать если всё время отказываться?
Я в шоке!
А по поводу [vba]

Code

Application.FindFormat.MergeCells

[/vba] так ты это круто сделал. Нужно будет попробовать разобраться (просто я с методами Find не очень дружу biggrin )

С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_ST — Вторник, 30.10.2012, 21:00

Ответить

KuklP

Дата: Вторник, 30.10.2012, 21:19 |
Сообщение № 10

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация:
486
±

Замечаний:
0% ±

2003-2010

Ну да, топчется по двум, сиреневой и зеленой. Дык, переделай через find. Все лучше, чем все ячейки перебирать:-)

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

Alex_ST

Дата: Вторник, 30.10.2012, 21:24 |
Сообщение № 11

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176

Репутация:
604
±

Замечаний:
0% ±

2003

Лена, абсолютно точно найдена закономерность! Браво!
Если объединённые ячейки имеют общие строки, то глючит.
А если нет, то всё нормально!
Вот теперь бы понять, где тут собака порылась?

А по поводу метода Find,Серёга, так я с ним обязательно поразбираюсь завтра.
Да и я не думаю, что перебор ячеек без селекта так уж долог если учесть, что ячейки объединяются пользователем в ручную и потому их не может быть огромное число.
Но хочется понять почему мой метод глючит (ну просто для эрудиции в конце-концов).

С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_ST — Вторник, 30.10.2012, 21:25

Ответить

Дата: Вторник, 30.10.2012, 22:10 |
Сообщение № 12

Группа: Друзья

Ранг: Участник

Сообщений: 64

Репутация:
59
±

Замечаний:
0% ±

2003

Вариант:
[vba]

Code

Sub UnMergeInRangeSelection()
     Dim MAreas As New Collection
     Dim SRng As Range, Cell As Range
     ‘
     On Error Resume Next
     Set SRng = Selection
     If SRng Is Nothing Then
         Err.Clear
         Exit Sub
     End If
     Set SRng = Intersect(SRng, ActiveSheet.UsedRange)
     For Each Cell In SRng
         If Cell.MergeCells Then MAreas.Add Cell.MergeArea, Cell.MergeArea.Address
     Next
     On Error GoTo 0
     If MAreas.Count > 0 Then
         For Each Cell In MAreas
             Cell.Select
             If MsgBox(Cell.Address, vbYesNo + vbDefaultButton2, «Разъединить ?») = vbYes Then Cell.UnMerge
         Next
     Else
         MsgBox «В выбранном диапазоне нет объединенных ячеек.», , «»
     End If
End Sub

[/vba]

Excel изощрён, но не злонамерен

Ответить

Alex_ST

Дата: Вторник, 30.10.2012, 22:15 |
Сообщение № 13

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176

Репутация:
604
±

Замечаний:
0% ±

2003

Ну, с коллекциями, ИМХО, это Вы зря. Может и будет работать (пока не проверял и не разбирался), но не слишком ли для такой простой операции?

С уважением,
Алексей
MS Excel 2003 — the best!!!

Ответить

KuklP

Дата: Вторник, 30.10.2012, 22:20 |
Сообщение № 14

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация:
486
±

Замечаний:
0% ±

2003-2010

Чего это? Очень хорошее решение. И гарантированно не будет скакать по одним ячейкам:) Только я бы все равно убрал проверку ВСЕХ ячеек.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

nerv

Дата: Среда, 31.10.2012, 00:00 |
Сообщение № 15

Группа: Редакторы

Ранг: Обитатель

Сообщений: 431

[vba]

Code

Sub UnMerge()
Dim area As Range
Dim cell As Range

If Not TypeOf Selection Is Range Then Exit Sub

           For Each area In Intersect(Selection, ActiveSheet.UsedRange).areas
         For Each cell In area
             If cell.MergeCells And cell.Address = cell.MergeArea.Cells(1).Address Then
                 If MsgBox(cell.Address, vbYesNo + vbDefaultButton2, «Unmerge?») = vbYes Then
                     cell.UnMerge
                 End If
             End If
         Next
     Next
End Sub

[/vba]

Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина — самый громкий звук

YM 41001156540584 / WM WMR R21924176233

https://github.com/nervgh/vba

Ответить

Alex_ST

Дата: Среда, 31.10.2012, 08:34 |
Сообщение № 16

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176

Репутация:
604
±

Замечаний:
0% ±

2003

Вот честно говорю: утром по пути на работу так и подумал, что дело скорее всего в Areas и нужно будет делать двойной цикл!
Спасибо, nerv, сейчас попробую.
(только, естественно, в соответствии с рекомендациями классиков, не буду использовать имён процедур и переменных, совпадающих с названиями свойств и методов объектов VBA biggrin )

С уважением,
Алексей
MS Excel 2003 — the best!!!

Ответить

Alex_ST

Дата: Среда, 31.10.2012, 11:00 |
Сообщение № 17

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176

Репутация:
604
±

Замечаний:
0% ±

2003

Полирнул вариант с Areas.
Теперь всё нормально работает[vba]

Code

Sub FindMergeCells()   ‘ перебрать все объединённые ячейки в выделенном диапазоне и предложить пользователю их разгруппировать
    If Not TypeOf Selection Is Range Then Exit Sub
    If Intersect(Selection, ActiveSheet.UsedRange) Is Nothing Then Exit Sub
    Dim rArea As Range, rCell As Range
    Dim rSel As Range: Set rSel = Selection   ‘только для того, чтобы можно было восстановить Selection после обработки
    For Each rArea In Intersect(Selection, ActiveSheet.UsedRange).Areas
       For Each rCell In rArea
          If rCell.MergeCells And rCell.Address = rCell.MergeArea.Cells(1).Address Then
             rCell.Select
             If MsgBox(«Разгруппировать ячейку » & rCell.Address(0, 0) & » ?», vbYesNo + vbQuestion, «Найдена объединённая ячейка») = vbYes Then rCell.UnMerge
          End If
       Next rCell
    Next rArea
    rSel.Select   ‘ восстановить Selection после обработки
End Sub

[/vba]
одно маленькое неудобство: при выделении столбца не обрабатываются объединённые ячейки, левая верхняя ячейка которых не входит в выделение (см.пример)

К сообщению приложен файл:

9689976.xls
(41.0 Kb)

С уважением,
Алексей
MS Excel 2003 — the best!!!

Ответить

nerv

Дата: Среда, 31.10.2012, 15:41 |
Сообщение № 18

Группа: Редакторы

Ранг: Обитатель

Сообщений: 431

всем привет

Quote (Формуляр)

Кстати, для эстетов , вместо
If TypeName(Selection) <> «Range» Then Exit Sub
красивше
If not TypeOf Selection Is Range Then Exit Sub

никаких «красивше». Так правильно. Потому, что в данном случае нужно проверить тип объекта, а не получить название типа.

Quote (Alex_ST)

что дело скорее всего в Areas и нужно будет делать двойной цикл!

Areas тут не при чем. Это на случай выделения несмежных диапазонов.

Quote (Alex_ST)

(только, естественно, в соответствии с рекомендациями классиков, не буду использовать имён процедур и переменных, совпадающих с названиями свойств и методов объектов VBA

глупости. Если имя не совпадает с глобальным и соответствует правилам наименования, его можно использовать. Т.к. то, что скрыто внутри объекта, там и останется. Зато читаемость твоего кода заметно ухудшилась. Впрочем, даже если имя совпадает с глобальным, его тоже можно использовать, но в этом случае оно (глобальное) будет перекрыто локальным:
[vba]

Code

Sub io()
Dim Range As Range
Range(«A1»).Select ‘ err: локальное имя перекрыло глобальное
End Sub

[/vba]
Жду ваши возражения.

Еще. Alex_ST, ты специально делаешь свой код не читаемым? Зачем лепить все в кучу? Если очень хочется, можно воспользоваться минификатором или обсфукатором.

Quote (Alex_ST)

If Intersect(Selection, ActiveSheet.UsedRange) Is Nothing Then Exit Sub

Нафиг не надо, т.к. в первый цикл по областям уже включена эта проверка.

КЭП: дело в
[vba]

Code

cell.Address = cell.MergeArea.Cells(1).Address

[/vba]

Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина — самый громкий звук

YM 41001156540584 / WM WMR R21924176233

https://github.com/nervgh/vba

Сообщение отредактировал nerv — Среда, 31.10.2012, 15:48

Ответить

Alex_ST

Дата: Среда, 31.10.2012, 16:21 |
Сообщение № 19

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176

Репутация:
604
±

Замечаний:
0% ±

2003

Quote (nerv)

Alex_ST, ты специально делаешь свой код не читаемым?

nerv, ты первый, кто назвал мой код не читаемым. Может, не в коде дело, а в том, кто его читает? biggrin

Quote (nerv)

Нафиг не надо

Если бы было не надо, то я бы и не ставил.
Попробуй в своём коде выделить на листе диапазон, лежащий вне UsedRange и запусти свой макрос. Вылетишь в дебаггер.

Quote (nerv)

Areas тут не при чем

тут согласен. Просто сравнивать адреса я пробовал изначально, но вместо [vba]

Code

rCell.Address = rCell.MergeArea.Cells(1).Address

[/vba]писАл[vba]

Code

rCell.Address = rCell.Cells(1).Address

[/vba] вот и глючило.
.
.
А вообще-то, смени тон, пожалуйста.
Мы с тобой не близкие друзья и в пивняке общаемся.

С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_ST — Среда, 31.10.2012, 17:01

Ответить

nerv

Дата: Среда, 31.10.2012, 16:47 |
Сообщение № 20

Группа: Редакторы

Ранг: Обитатель

Сообщений: 431

Quote (Alex_ST)

Если бы было не надо, то я бы и не ставил. Попробуй в своём коде выделить на листе диапазон, лежащий вне UsedRange и запусти свой макрос. Вылетишь в дебаггер.

был не прав

Quote (Alex_ST)

однако, без перебора по ним почему-то глючит при перекрытии по строкам

все нормально, можешь проверить

Quote (Alex_ST)

И вообще, смени тон, пожалуйста.

сори Я еще не обедал. А когда я голодный, я злой pirate

Quote (Alex_ST)

и в пивняке общаемся

ну, для привняка то как раз нормально biggrin

по задаче: только собирать в массив/коллекцию и проверять

Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина — самый громкий звук

YM 41001156540584 / WM WMR R21924176233

https://github.com/nervgh/vba

Сообщение отредактировал nerv — Среда, 31.10.2012, 16:52

Ответить

Источник

Return to VBA Code Examples

This tutorial will demonstrate how to group and ungroup rows and columns in VBA.

Group Rows or Columns

To group rows or columns apply the Group Method to the rows or columns:

Rows("3:5").Group

Columns("C:D").Group

Ungroup Rows or Columns

To ungroup the rows or columns, simply use the Ungroup Method:

Rows("3:5").Ungroup

Columns("C:D").Ungroup

Expand All “Grouped” Outline Levels

To expand all grouped outline levels, use this line of code:

ActiveSheet.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8

To collapse all outline levels, use this line of code:

ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1

VBA Coding Made Easy

Stop searching for VBA code online. Learn more about AutoMacro — A VBA Code Builder that allows beginners to code procedures from scratch with minimal coding knowledge and with many time-saving features for all users!

Learn More!

Источник

Содержание

VBA Group Rows & Columns
Group Rows or Columns
Ungroup Rows or Columns
Expand All “Grouped” Outline Levels
VBA Coding Made Easy
VBA Code Examples Add-in
VBA Code Generator
AutoMacro: VBA Add-in with Hundreds of Ready-To-Use VBA Code Examples & much more!
What is AutoMacro?
Практическое руководство. Программное группирование строк на листе
Использование элемента управления NamedRange
Создание группы элементов управления NamedRange на листе
Использование собственных диапазонов Excel
Создание группы диапазонов Excel на листе
Группировать строки vba excel
Многоуровневая группировка строк
Ссылки по теме

VBA Group Rows & Columns

In this Article

This tutorial will demonstrate how to group and ungroup rows and columns in VBA.

Group Rows or Columns

To group rows or columns apply the Group Method to the rows or columns:

Ungroup Rows or Columns

To ungroup the rows or columns, simply use the Ungroup Method:

Expand All “Grouped” Outline Levels

To expand all grouped outline levels, use this line of code:

To collapse all outline levels, use this line of code:

VBA Coding Made Easy

VBA Code Examples Add-in

Easily access all of the code examples found on our site.

Simply navigate to the menu, click, and the code will be inserted directly into your module. .xlam add-in.

(No installation required!)

VBA Code Generator

AutoMacro: VBA Add-in with Hundreds of Ready-To-Use VBA Code Examples & much more!

What is AutoMacro?

AutoMacro is an add-in for VBA that installs directly into the Visual Basic Editor. It comes loaded with code generators, an extensive code library, the ability to create your own code library, and many other time-saving tools and utilities that add much needed functionality to the outdated VBA Editor.

Источник

Практическое руководство. Программное группирование строк на листе

Применимо к: Visual Studio Visual Studio для Mac Visual Studio Code

Можно сгруппировать одну или несколько целых строк. Чтобы создать группу на листе, используйте NamedRange элемент управления или собственный объект диапазона Excel.

Применимо к: Сведения в этом разделе относятся к проектам уровня документа и проектам надстроек VSTO для Excel. Дополнительные сведения см. в разделе «Функции», доступные в приложении Office и типе проекта.

Использование элемента управления NamedRange

При добавлении NamedRange элемента управления в проект уровня документа во время разработки можно использовать этот элемент управления для программного создания группы. В следующем примере предполагается, что на одном листе есть три NamedRange элемента управления: data2001 , data2002 и dataAll . Каждый именованный диапазон ссылается на целую строку на листе.

Создание группы элементов управления NamedRange на листе

Группирование трех именованных диапазонов путем вызова Group метода каждого диапазона. Этот код следует разместить в классе листа, а не в классе ThisWorkbook .

Чтобы разгруппировать строки, вызовите Ungroup метод.

Использование собственных диапазонов Excel

В коде предполагается, что у вас есть три диапазона Excel с именем data2001 , data2002 а dataAll также на листе.

Создание группы диапазонов Excel на листе

Группирование трех именованных диапазонов путем вызова Group метода каждого диапазона. В следующем примере предполагается, что на одном листе есть три Range элемента управления с именем data2001 , data2002 а dataAll также на одном листе. Каждый именованный диапазон ссылается на целую строку на листе.

Чтобы разгруппировать строки, вызовите Ungroup метод.

Источник

Группировать строки vba excel

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

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

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

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

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

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

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

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

Сообщение Добрый день!

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

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

Пример прилагаю. Благодарю за уделенное время! Автор — Sl1mka
Дата добавления — 10.07.2015 в 13:17

Источник

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

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

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

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

бюджетировании — статьи доходов/расходов группируются в блоки (cost centers) или по географическому признаку (страна-край-город)
управлении проектами — этапы проектов разбиты обычно на более мелкие подзадачи и действия
строительных сметах — похожим образом обычно расписываются расчеты расхода материалов и их стоимости при строительстве
и т.д. — дальше придумайте сами.

Делать такую группировку вручную весьма мучительно, вследствие неудобности и ограниченности средств группировки самого Excel. Поэтому, столкнувшись как-то с подобной задачей в одном из своих проектов, я написал макрос для автоматической группировки подобных списков, которым и хочу тут поделиться. Чтобы применить его к вашему списку, проделайте следующие действия:

Нажмите сочетание клавиш ALT+F11, чтобы открыть редактор Visual Basic. В нем выберите в меню команду Insert — Module, чтобы вставить новый модуль и скопируйте туда текст макроса:

При необходимости, текст можно слегка подкорректировать под ваши особенности, а именно изменить:

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

Важно! Макрос предполагает, что:

Уровни заполняются по порядку, т.е., например, уровень 3 не может быть написан, если ему не предшествовал уровень 2.
В первом столбце списка в последней строке должно быть слово Конец, которое необходимо, чтобы макрос понял, где заканчивается список и пора остановиться:

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

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

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

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 Родитель Ссылка

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

округ	Сервис 1	Фио 6	1
округ	Сервис 1	Фио 7	43
округ	Сервис 1 итого	44
округ	Сервис 2	Фио 1	13
округ	Сервис 2	Фио 2	18
округ	Сервис 2	Фио 3	9
округ	Сервис 2	Фио 4	3
округ	Сервис 2 итого	Фио 5	3
округ итого	134
округ 1	Сервис 3	Фио 1	13
округ 1	Сервис 3	Фио 2	18
округ 1	Сервис 3	Фио 3	9
округ 1	Сервис 3	Фио 4	3
округ 1	Сервис 3 итого	Фио 5	3
округ 1 итого	46
Общий итог	180

Николай, добрый день!

Неужели в Экселе стоит ограничение по количеству уровней группировки =8? если нет, то где-то это настраивается?
У меня есть отчет, в котором 11 уровней группировки, но после 8 уровня Эксель не дает больше создать и все нижние перегруппировывает в более высокий

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

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

With ActiveSheet.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlLeft
End With
Selection.ApplyOutlineStyles

Добрый день, а можно ли сделать группировку по датам (суткам), таблицы такого вида:

Добрый день. Всех с наступающим Новым Годом. Пытаюсь разобраться с многоуровневой группировкой строк, макрос что опубликован выше вроде подходит для решения моей задачи, но почему-то не получается, где моя ошибка?
Пример:

Контрагент. Канал збуту	Супервайзер	Торговий представник	Транспортный код
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 колонке. НО НИЧЕГО НЕ ПРОИСХОДИТ. Может кто подскажет. Спасибо заранее.

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

Источник