Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Автоформирование иерархическ. группировок из плоской таблицы - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Автоформирование иерархическ. группировок из плоской таблицы (Макросы/Sub)
Автоформирование иерархическ. группировок из плоской таблицы
abtextime Дата: Пятница, 22.04.2016, 12:53 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
Уважаемые коллеги,

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

Хочется людям: нажать кнопочку и автоматически привести к привычному им виду с группировками строк (с вложенной иерархией по уровням)

Другие варианты организации данных не хотят (предлагалось).

Как делать - в целом представляю, но совсем не работаю с группировками, плюхаться буду долго (относительно).

Если кто делал что-то похожее или может быстро нащелкать макрос - буду крайне благодарен.

По файлу-примеру. На первом листе - начальное состояние (кусочек), на втором - что хотят получить в результате работы макроса.
К сообщению приложен файл: -3-.xlsx(11Kb)


Сообщение отредактировал abtextime - Пятница, 22.04.2016, 12:53
 
Ответить
СообщениеУважаемые коллеги,

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

Хочется людям: нажать кнопочку и автоматически привести к привычному им виду с группировками строк (с вложенной иерархией по уровням)

Другие варианты организации данных не хотят (предлагалось).

Как делать - в целом представляю, но совсем не работаю с группировками, плюхаться буду долго (относительно).

Если кто делал что-то похожее или может быстро нащелкать макрос - буду крайне благодарен.

По файлу-примеру. На первом листе - начальное состояние (кусочек), на втором - что хотят получить в результате работы макроса.

Автор - abtextime
Дата добавления - 22.04.2016 в 12:53
_Boroda_ Дата: Пятница, 22.04.2016, 13:40 | Сообщение № 2
Группа: Модераторы
Ранг: Экселист
Сообщений: 9827
Репутация: 4148 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Что-то типа вот этого можно. По Селекшену. Рубит по пусто и Итого. Тормознутый.
[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]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЧто-то типа вот этого можно. По Селекшену. Рубит по пусто и Итого. Тормознутый.
[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]

Автор - _Boroda_
Дата добавления - 22.04.2016 в 13:40
abtextime Дата: Пятница, 22.04.2016, 14:07 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
_Boroda_,

спасибо большое, есть от чего оттолкнуться по крайней мере ...

Но чуток не так структуру формирует, есть отличия от "хотелок" людей.

Отличия в файле
К сообщению приложен файл: -3-.xlsm(19Kb)
 
Ответить
Сообщение_Boroda_,

спасибо большое, есть от чего оттолкнуться по крайней мере ...

Но чуток не так структуру формирует, есть отличия от "хотелок" людей.

Отличия в файле

Автор - abtextime
Дата добавления - 22.04.2016 в 14:07
_Boroda_ Дата: Пятница, 22.04.2016, 14:29 | Сообщение № 4
Группа: Модераторы
Ранг: Экселист
Сообщений: 9827
Репутация: 4148 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Странно. Я ж проверял, а не просто так написал. Посмотрите мой файл.
Попробуйте там ткнуться в первом листе на кнопку, предварительно выделив зеленое.
На листе Итог то, что получается у меня

Можно попробовать пустить цикл не справа налево, а слева направо
К сообщению приложен файл: -3-12.xlsm(25Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995


Сообщение отредактировал _Boroda_ - Пятница, 22.04.2016, 15:12
 
Ответить
СообщениеСтранно. Я ж проверял, а не просто так написал. Посмотрите мой файл.
Попробуйте там ткнуться в первом листе на кнопку, предварительно выделив зеленое.
На листе Итог то, что получается у меня

Можно попробовать пустить цикл не справа налево, а слева направо

Автор - _Boroda_
Дата добавления - 22.04.2016 в 14:29
abtextime Дата: Пятница, 22.04.2016, 15:15 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
_Boroda_,
Александр, да, макрос, кажется, работает на ура, как надо! Правда, пришлось реальные данные в твой файл скопировать, а не наоборот. Странно, конечно, ну это уже мелочи, разберемся.

Спасибо большое, мэтр!
 
Ответить
Сообщение_Boroda_,
Александр, да, макрос, кажется, работает на ура, как надо! Правда, пришлось реальные данные в твой файл скопировать, а не наоборот. Странно, конечно, ну это уже мелочи, разберемся.

Спасибо большое, мэтр!

Автор - abtextime
Дата добавления - 22.04.2016 в 15:15
abtextime Дата: Пятница, 22.04.2016, 15:25 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
[offtop]Я бы не сказал, что тормознутый. 8000 строк и 8 столбцов отработал секунд за 10
[moder]Это я тормознутый. У меня был открыт рабочий файл 187 мегов на общем диске и я вместе с ним запускал и этот макрос. Конечно он тормозил.


Сообщение отредактировал _Boroda_ - Пятница, 22.04.2016, 15:28
 
Ответить
Сообщение[offtop]Я бы не сказал, что тормознутый. 8000 строк и 8 столбцов отработал секунд за 10
[moder]Это я тормознутый. У меня был открыт рабочий файл 187 мегов на общем диске и я вместе с ним запускал и этот макрос. Конечно он тормозил.

Автор - abtextime
Дата добавления - 22.04.2016 в 15:25
dredder_gun Дата: Вторник, 03.05.2016, 08:10 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Спасибо большое _Boroda_. Похожая была проблема
 
Ответить
СообщениеСпасибо большое _Boroda_. Похожая была проблема

Автор - dredder_gun
Дата добавления - 03.05.2016 в 08:10
abtextime Дата: Пятница, 05.08.2016, 17:21 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
Всем привет!

Предложенный уважаемым Александром _Boroda_ макрос успешно работает в виндовом Excel 2010, но при попытке запустить на Mac'е не фурычит (со слов, запускал не я, посмотреть ничего не могу). Кто знает, это нормальная или форс-мажорная ситуация?


Сообщение отредактировал abtextime - Пятница, 05.08.2016, 17:22
 
Ответить
СообщениеВсем привет!

Предложенный уважаемым Александром _Boroda_ макрос успешно работает в виндовом Excel 2010, но при попытке запустить на Mac'е не фурычит (со слов, запускал не я, посмотреть ничего не могу). Кто знает, это нормальная или форс-мажорная ситуация?

Автор - abtextime
Дата добавления - 05.08.2016 в 17:21
krosav4ig Дата: Пятница, 05.08.2016, 18:12 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 1420
Репутация: 585 ±
Замечаний: 0% ±

Excel 2007, 2013
Добрый вечер. Исчо вариант
[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
[/vba]
К сообщению приложен файл: 1879812.xlsm(16Kb)


(_)Õvõ(_)

Сообщение отредактировал krosav4ig - Пятница, 05.08.2016, 18:22
 
Ответить
СообщениеДобрый вечер. Исчо вариант
[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
[/vba]

Автор - krosav4ig
Дата добавления - 05.08.2016 в 18:12
abtextime Дата: Пятница, 05.08.2016, 18:55 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
krosav4ig, спасибо, работает на тестовом примере, в пнд подпилю и покормлю реальные данные
 
Ответить
Сообщениеkrosav4ig, спасибо, работает на тестовом примере, в пнд подпилю и покормлю реальные данные

Автор - abtextime
Дата добавления - 05.08.2016 в 18:55
abtextime Дата: Пятница, 05.08.2016, 18:56 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
но вопрос о макросах на MACe остается
 
Ответить
Сообщениено вопрос о макросах на MACe остается

Автор - abtextime
Дата добавления - 05.08.2016 в 18:56
Pelena Дата: Пятница, 05.08.2016, 19:04 | Сообщение № 12
Группа: Модераторы
Ранг: Экселист
Сообщений: 10413
Репутация: 2357 ±
Замечаний: 0% ±

Excel 2010 & Mac Excel 2011
вопрос о макросах на MACe остается

У меня на Mac'е работают оба макроса и Саши, и Андрея


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
Сообщение
вопрос о макросах на MACe остается

У меня на Mac'е работают оба макроса и Саши, и Андрея

Автор - Pelena
Дата добавления - 05.08.2016 в 19:04
abtextime Дата: Пятница, 05.08.2016, 19:14 | Сообщение № 13
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
У меня на Mac'е работают оба макроса


Pelena, спасибо, тогда буду копать - может Селекшен не сделали или не так сделали, как надо (в макросе Александра)
 
Ответить
Сообщение
У меня на Mac'е работают оба макроса


Pelena, спасибо, тогда буду копать - может Селекшен не сделали или не так сделали, как надо (в макросе Александра)

Автор - abtextime
Дата добавления - 05.08.2016 в 19:14
abtextime Дата: Понедельник, 08.08.2016, 13:22 | Сообщение № 14
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
Коллеги, привет

Подскажите, плиз, как в макросе снять галку с «Итоги в строках под данными».

Спасибо!
 
Ответить
СообщениеКоллеги, привет

Подскажите, плиз, как в макросе снять галку с «Итоги в строках под данными».

Спасибо!

Автор - abtextime
Дата добавления - 08.08.2016 в 13:22
_Boroda_ Дата: Понедельник, 08.08.2016, 13:25 | Сообщение № 15
Группа: Модераторы
Ранг: Экселист
Сообщений: 9827
Репутация: 4148 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Макрорекодер с поставленной галкой
[vba]
Код
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
[/vba]
Со снятой
[vba]
Код
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=False
[/vba]
Где отличаются - там и снятие галки


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеМакрорекодер с поставленной галкой
[vba]
Код
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
[/vba]
Со снятой
[vba]
Код
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=False
[/vba]
Где отличаются - там и снятие галки

Автор - _Boroda_
Дата добавления - 08.08.2016 в 13:25
abtextime Дата: Понедельник, 08.08.2016, 14:11 | Сообщение № 16
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, Саша, спасибо большое!
 
Ответить
Сообщение_Boroda_, Саша, спасибо большое!

Автор - abtextime
Дата добавления - 08.08.2016 в 14:11
abtextime Дата: Понедельник, 08.08.2016, 16:18 | Сообщение № 17
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
Видимо,
[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]
 
Ответить
СообщениеВидимо,
[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]

Автор - abtextime
Дата добавления - 08.08.2016 в 16:18
krosav4ig Дата: Вторник, 09.08.2016, 02:21 | Сообщение № 18
Группа: Друзья
Ранг: Старожил
Сообщений: 1420
Репутация: 585 ±
Замечаний: 0% ±

Excel 2007, 2013
если ниже строк, которые нужно группировать ничего нет, то можно немного схитрить :)
[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]


(_)Õvõ(_)

Сообщение отредактировал krosav4ig - Вторник, 09.08.2016, 02:26
 
Ответить
Сообщениеесли ниже строк, которые нужно группировать ничего нет, то можно немного схитрить :)
[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]

Автор - krosav4ig
Дата добавления - 09.08.2016 в 02:21
abtextime Дата: Вторник, 09.08.2016, 11:37 | Сообщение № 19
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
krosav4ig, элегантно! впрочем. как всегда! Спасибо!
 
Ответить
Сообщениеkrosav4ig, элегантно! впрочем. как всегда! Спасибо!

Автор - abtextime
Дата добавления - 09.08.2016 в 11:37
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Автоформирование иерархическ. группировок из плоской таблицы (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!