Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сгруппировать во всей книге все столбцы, которые сверху имеют пометку
 
#1
29.09.2021 16:59:51
Добрый день, знатоки!

Есть задача: как в книге с несколькими вкладками, макросом-командой сгруппировать все столбцы во всей книге сразу, которые сверху имеют пометку "Y" и не группировать столбцы с пометкой "X" (пометки в строке 1:1 на каждой вкладке) . При этом столбцы должны именно группироваться (+/-), а не скрываться. Т.е. если мы меняем значения X на и Y или наоборот, то макрос должен перегруппировать столбцы исходя из новых вводных.
 
 
 
#2
29.09.2021 17:24:43
Цитата
rogert905 написал:
сгруппировать все столбцы во всей книге сразу
запускайте когда Вам нужно или повесть его на какое-нибудь событие  => КЛАЦ
Код
Sub mrshkei()
Dim lcol As Long, i As Long, n As Long, sh As Worksheet
For Each sh In Worksheets
With sh
    lcol = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
    .Cells.ClearOutline
    For i = 1 To lcol
        If .Cells(1, i) = "Y" Then
        For n = i + 1 To lcol
            If .Cells(1, n) <> "Y" Then
                .Range(.Cells(1, i), .Cells(1, n - 1)).Columns.Group
                i = n
                Exit For
            End If
        Next n
        End If
    Next i
End With
Next sh
End Sub
Изменено: Mershik - 29.09.2021 17:38:32
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
29.09.2021 17:41:37
Спасибо, работает легко и изящно). А можно еще добавить в макрос дополнительное действие, чтобы вновь сгруппированные столбцы группировались во всей книге, т.е. плюсики закрывались на всех листах?
Изменено: vikttur - 30.09.2021 14:18:51
 
 
 
#4
29.09.2021 17:44:16
вот это цитирование:
Цитата
плюсики закрывались на всех листах
Код
Sub mrshkei()
Dim lcol As Long, i As Long, n As Long, sh As Worksheet
Application.ScreenUpdating = False
For Each sh In Worksheets
With sh
sh.Activate
    lcol = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
    .Cells.ClearOutline
    For i = 1 To lcol
        If .Cells(1, i) = "Y" Then
        For n = i + 1 To lcol
            If .Cells(1, n) <> "Y" Then
                .Range(.Cells(1, i), .Cells(1, n - 1)).Columns.Group
                .Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
                i = n
                Exit For
            End If
        Next n
        End If
    Next i
End With
Next sh
Application.ScreenUpdating = True
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
30.09.2021 13:04:05
Работает, только видимо макрос делает какой-то долгий пересчет, потому что книга зависает на 10 минут. Может быть как-то ограничить количество столбцов обсчитываемых на каждом листе - например только первые 200 столбцов.
Изменено: vikttur - 30.09.2021 14:19:44
 
 
 
#6
30.09.2021 14:16:01
rogert905, вопрос в количестве листов, количестве столбцов на листе...
попробуйте добавить в начало макроса строку
Код
Application.Calculation = xlCalculationManual
и в конец строку
Код
Application.Calculation = xlCalculationAutomatic
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#7
30.09.2021 15:03:57
Да. теперь работает моментально) Спасибо! Хорошее простое решение, можно адаптировать под себя как угодно флагами X  и Y
Изменено: vikttur - 30.09.2021 15:18:13
 
 
 
#8
15.10.2021 10:41:52
Mershik, добрый день!

А можно еще внести последние штрихи, как сделать так, чтобы макрос не трогал строки вообще - не сбрасывал их группировку. Работал только со столбцами.
 
 
 
#9
28.10.2021 09:58:54
Цитата
rogert905 написал:
не трогал строки вообще - не сбрасывал их группировку.
замените
Код
 .Cells.ClearOutline
на
Код
.Columns.Ungroup
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#10
13.12.2021 13:35:02
Цитата
написал:
.Columns.Ungroup
Ругается
Изменено: rogert905 - 13.12.2021 13:35:55
 
 
 
#11
13.12.2021 13:41:49
И почему бы ему не ругаться, если сгруппированных столбцов нет?
 
 
 
Страницы: 1
Наверх