Вводные: есть плоская таблица в которой несколько начальных столбцов формируют строго вложенную иерархию, от первого до N. Таблица содержит несколько тысяч строк
Хочется людям: нажать кнопочку и автоматически привести к привычному им виду с группировками строк (с вложенной иерархией по уровням)
Другие варианты организации данных не хотят (предлагалось).
Как делать - в целом представляю, но совсем не работаю с группировками, плюхаться буду долго (относительно).
Если кто делал что-то похожее или может быстро нащелкать макрос - буду крайне благодарен.
По файлу-примеру. На первом листе - начальное состояние (кусочек), на втором - что хотят получить в результате работы макроса.
Уважаемые коллеги,
Вводные: есть плоская таблица в которой несколько начальных столбцов формируют строго вложенную иерархию, от первого до N. Таблица содержит несколько тысяч строк
Хочется людям: нажать кнопочку и автоматически привести к привычному им виду с группировками строк (с вложенной иерархией по уровням)
Другие варианты организации данных не хотят (предлагалось).
Как делать - в целом представляю, но совсем не работаю с группировками, плюхаться буду долго (относительно).
Если кто делал что-то похожее или может быстро нащелкать макрос - буду крайне благодарен.
По файлу-примеру. На первом листе - начальное состояние (кусочек), на втором - что хотят получить в результате работы макроса.abtextime
Что-то типа вот этого можно. По Селекшену. Рубит по пусто и Итого. Тормознутый. [vba]
Код
Sub tt() Dim d_ As Range Set d_ = Selection r0_ = d_.Row r1_ = r0_ + d_.Rows.Count - 1 c_ = d_.Columns.Count Application.ScreenUpdating = 0 For i = c_ To 2 Step -1 Rows(r0_ & ":" & r1_).Group For j = r0_ To r1_ z_ = Cells(j, i) If z_ = "" Or z_ = "Итого" Then Rows(j).Ungroup End If Next j Next i End Sub
[/vba]
Что-то типа вот этого можно. По Селекшену. Рубит по пусто и Итого. Тормознутый. [vba]
Код
Sub tt() Dim d_ As Range Set d_ = Selection r0_ = d_.Row r1_ = r0_ + d_.Rows.Count - 1 c_ = d_.Columns.Count Application.ScreenUpdating = 0 For i = c_ To 2 Step -1 Rows(r0_ & ":" & r1_).Group For j = r0_ To r1_ z_ = Cells(j, i) If z_ = "" Or z_ = "Итого" Then Rows(j).Ungroup End If Next j Next i End Sub
Странно. Я ж проверял, а не просто так написал. Посмотрите мой файл. Попробуйте там ткнуться в первом листе на кнопку, предварительно выделив зеленое. На листе Итог то, что получается у меня
Можно попробовать пустить цикл не справа налево, а слева направо
Странно. Я ж проверял, а не просто так написал. Посмотрите мой файл. Попробуйте там ткнуться в первом листе на кнопку, предварительно выделив зеленое. На листе Итог то, что получается у меня
Можно попробовать пустить цикл не справа налево, а слева направо_Boroda_
_Boroda_, Александр, да, макрос, кажется, работает на ура, как надо! Правда, пришлось реальные данные в твой файл скопировать, а не наоборот. Странно, конечно, ну это уже мелочи, разберемся.
Спасибо большое, мэтр!
_Boroda_, Александр, да, макрос, кажется, работает на ура, как надо! Правда, пришлось реальные данные в твой файл скопировать, а не наоборот. Странно, конечно, ну это уже мелочи, разберемся.
[offtop]Я бы не сказал, что тормознутый. 8000 строк и 8 столбцов отработал секунд за 10 [moder]Это я тормознутый. У меня был открыт рабочий файл 187 мегов на общем диске и я вместе с ним запускал и этот макрос. Конечно он тормозил.
[offtop]Я бы не сказал, что тормознутый. 8000 строк и 8 столбцов отработал секунд за 10 [moder]Это я тормознутый. У меня был открыт рабочий файл 187 мегов на общем диске и я вместе с ним запускал и этот макрос. Конечно он тормозил.abtextime
Сообщение отредактировал _Boroda_ - Пятница, 22.04.2016, 15:28
Предложенный уважаемым Александром _Boroda_ макрос успешно работает в виндовом Excel 2010, но при попытке запустить на Mac'е не фурычит (со слов, запускал не я, посмотреть ничего не могу). Кто знает, это нормальная или форс-мажорная ситуация?
Всем привет!
Предложенный уважаемым Александром _Boroda_ макрос успешно работает в виндовом Excel 2010, но при попытке запустить на Mac'е не фурычит (со слов, запускал не я, посмотреть ничего не могу). Кто знает, это нормальная или форс-мажорная ситуация?abtextime
Сообщение отредактировал abtextime - Пятница, 05.08.2016, 17:22
Sub dd() Dim col As Range, ar As Range With Application: .EnableEvents = 0: .ScreenUpdating = 0 For Each col In [A8:F27].Columns With col.SpecialCells(xlCellTypeConstants, 23) For Each ar In .ColumnDifferences(.Cells(1)).Areas ar.EntireRow.Group Next End With Next .EnableEvents = 1: .ScreenUpdating = 1: End With End Sub
[/vba]
Добрый вечер. Исчо вариант [vba]
Код
Sub dd() Dim col As Range, ar As Range With Application: .EnableEvents = 0: .ScreenUpdating = 0 For Each col In [A8:F27].Columns With col.SpecialCells(xlCellTypeConstants, 23) For Each ar In .ColumnDifferences(.Cells(1)).Areas ar.EntireRow.Group Next End With Next .EnableEvents = 1: .ScreenUpdating = 1: End With End Sub
With ActiveSheet.Outline .SummaryRow = xlAbove End With
[/vba] решает задачу для всей структуры листа (что, собственно, и требовалось)
Также порешал задачу - избежать выделения для запуска макроса. В итоге получилась такая бяка, сильно не пинайте за корявость. Но вроде бы работает
[vba]
Код
Sub Gruppirovka() With ActiveSheet.Outline .AutomaticStyles = False .SummaryRow = xlAbove .SummaryColumn = xlRight End With Dim d_ As Range For i = 1 To ActiveSheet.UsedRange.Columns.Count For j = 1 To ActiveSheet.UsedRange.Rows.Count If ActiveSheet.Cells(j, i) = "Итого" Then i1 = i j1 = j Found = True Exit For End If If Found Then Exit For Next j Next i Found = False For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1 For j = 1 To ActiveSheet.UsedRange.Rows.Count If ActiveSheet.Cells(j, i) = "Итого" Then i2 = i j2 = ActiveSheet.UsedRange.Rows.Count Found = True Exit For End If If Found Then Exit For Next j Next i Set d_ = ActiveSheet.Range(ActiveSheet.Cells(j1, i1), ActiveSheet.Cells(j2, i2)) r0_ = d_.Row r1_ = r0_ + d_.Rows.Count - 1 c_ = d_.Columns.Count Application.ScreenUpdating = 0 For i = c_ To 2 Step -1 Rows(r0_ & ":" & r1_).Group For j = r0_ To r1_ z_ = Cells(j, i) If z_ = "" Or z_ = "Итого" Then Rows(j).Ungroup End If Next j Next i
End Sub
Sub dd() Dim col As Range, ar As Range Dim d_ As Range With Application: .EnableEvents = 0: .ScreenUpdating = 0 With ActiveSheet.Outline .AutomaticStyles = False .SummaryRow = xlAbove .SummaryColumn = xlRight End With For i = 1 To ActiveSheet.UsedRange.Columns.Count For j = 1 To ActiveSheet.UsedRange.Rows.Count If ActiveSheet.Cells(j, i) = "Итого" Then i1 = i j1 = j Found = True Exit For End If If Found Then Exit For Next j Next i Found = False For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1 For j = 1 To ActiveSheet.UsedRange.Rows.Count If ActiveSheet.Cells(j, i) = "Итого" Then i2 = i j2 = ActiveSheet.UsedRange.Rows.Count Found = True Exit For End If If Found Then Exit For Next j Next i Set d_ = ActiveSheet.Range(ActiveSheet.Cells(j1, i1), ActiveSheet.Cells(j2, i2)) For Each col In d_.Columns With col.SpecialCells(xlCellTypeConstants, 23) For Each ar In .ColumnDifferences(.Cells(1)).Areas ar.EntireRow.Group Next End With Next .EnableEvents = 1: .ScreenUpdating = 1: End With End Sub
[/vba]
Видимо, [vba]
Код
With ActiveSheet.Outline .SummaryRow = xlAbove End With
[/vba] решает задачу для всей структуры листа (что, собственно, и требовалось)
Также порешал задачу - избежать выделения для запуска макроса. В итоге получилась такая бяка, сильно не пинайте за корявость. Но вроде бы работает
[vba]
Код
Sub Gruppirovka() With ActiveSheet.Outline .AutomaticStyles = False .SummaryRow = xlAbove .SummaryColumn = xlRight End With Dim d_ As Range For i = 1 To ActiveSheet.UsedRange.Columns.Count For j = 1 To ActiveSheet.UsedRange.Rows.Count If ActiveSheet.Cells(j, i) = "Итого" Then i1 = i j1 = j Found = True Exit For End If If Found Then Exit For Next j Next i Found = False For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1 For j = 1 To ActiveSheet.UsedRange.Rows.Count If ActiveSheet.Cells(j, i) = "Итого" Then i2 = i j2 = ActiveSheet.UsedRange.Rows.Count Found = True Exit For End If If Found Then Exit For Next j Next i Set d_ = ActiveSheet.Range(ActiveSheet.Cells(j1, i1), ActiveSheet.Cells(j2, i2)) r0_ = d_.Row r1_ = r0_ + d_.Rows.Count - 1 c_ = d_.Columns.Count Application.ScreenUpdating = 0 For i = c_ To 2 Step -1 Rows(r0_ & ":" & r1_).Group For j = r0_ To r1_ z_ = Cells(j, i) If z_ = "" Or z_ = "Итого" Then Rows(j).Ungroup End If Next j Next i
End Sub
Sub dd() Dim col As Range, ar As Range Dim d_ As Range With Application: .EnableEvents = 0: .ScreenUpdating = 0 With ActiveSheet.Outline .AutomaticStyles = False .SummaryRow = xlAbove .SummaryColumn = xlRight End With For i = 1 To ActiveSheet.UsedRange.Columns.Count For j = 1 To ActiveSheet.UsedRange.Rows.Count If ActiveSheet.Cells(j, i) = "Итого" Then i1 = i j1 = j Found = True Exit For End If If Found Then Exit For Next j Next i Found = False For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1 For j = 1 To ActiveSheet.UsedRange.Rows.Count If ActiveSheet.Cells(j, i) = "Итого" Then i2 = i j2 = ActiveSheet.UsedRange.Rows.Count Found = True Exit For End If If Found Then Exit For Next j Next i Set d_ = ActiveSheet.Range(ActiveSheet.Cells(j1, i1), ActiveSheet.Cells(j2, i2)) For Each col In d_.Columns With col.SpecialCells(xlCellTypeConstants, 23) For Each ar In .ColumnDifferences(.Cells(1)).Areas ar.EntireRow.Group Next End With Next .EnableEvents = 1: .ScreenUpdating = 1: End With End Sub
если ниже строк, которые нужно группировать ничего нет, то можно немного схитрить :) [vba]
Код
Sub ddd() With Application: .EnableEvents = 0: .ScreenUpdating = 0 With ActiveSheet With .Outline .AutomaticStyles = False .SummaryRow = xlAbove .SummaryColumn = xlRight End With .Cells.Replace "Итого", "=all1", 1 With [all1].Dependents .Value = "Итого" For Each col In .Cells(1, 1).Resize(Rows.Count - .Row, _ Intersect(.EntireColumn, .EntireRow).Columns.Count).Columns With col.SpecialCells(xlCellTypeConstants, 23) For Each ar In .ColumnDifferences(.Cells(1)).Areas ar.EntireRow.Group Next End With Next End With End With .EnableEvents = 1: .ScreenUpdating = 1: End With End Sub
[/vba]
если ниже строк, которые нужно группировать ничего нет, то можно немного схитрить :) [vba]
Код
Sub ddd() With Application: .EnableEvents = 0: .ScreenUpdating = 0 With ActiveSheet With .Outline .AutomaticStyles = False .SummaryRow = xlAbove .SummaryColumn = xlRight End With .Cells.Replace "Итого", "=all1", 1 With [all1].Dependents .Value = "Итого" For Each col In .Cells(1, 1).Resize(Rows.Count - .Row, _ Intersect(.EntireColumn, .EntireRow).Columns.Count).Columns With col.SpecialCells(xlCellTypeConstants, 23) For Each ar In .ColumnDifferences(.Cells(1)).Areas ar.EntireRow.Group Next End With Next End With End With .EnableEvents = 1: .ScreenUpdating = 1: End With End Sub