Группировка столбцов excel vba - Word и Excel - помощь в работе с программами

Katerpiller

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

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

добрый день! прошу помочь в написании макроса. суть задачи — есть бланк, с разбивкой по кол-ву недель в месяце. по прошествии недели не актуальную инфо (прошлая неделя и следующая) необходимо сгруппировать, текущая неделя — разгруппировать. В одной книге типовых листов может быть до 5. еженедельно на такую механическую работу тратиться много времени. Хотелось написать макрос и вывести кнопки для каждой недели.

Прикрепленные файлы

Книга.zip (25.92 КБ)

Nordheim

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

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

25.09.2017 15:54:34

Цитата
Katerpiller написал: Хотелось написать макрос

А что мешает, если уж так хочется?

«Все гениальное просто, а все простое гениально!!!»

Katerpiller Пользователь Сообщений: 5 Регистрация: 25.09.2017	минимальные познания с помощью записи макроса что-то простенькое получается делать, а вот писать вручную код через VBA уже не вмоготу, к сожалению

Nordheim

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

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

25.09.2017 16:04:14

получается фраза

Цитата
Katerpiller написал: прошу помочь в написании макроса

Это значит написать все с нуля?

«Все гениальное просто, а все простое гениально!!!»

Katerpiller Пользователь Сообщений: 5 Регистрация: 25.09.2017	по факту да буду благодарна и любым подсказкам, можно ли это делать и с помощью ф-ции записи макроса или только вручную надо? или эта задача не посильна новичку — тогда и лезть нечего..

kuklp Пользователь Сообщений: 14868 Регистрация: 21.12.2012 E-mail и реквизиты в профиле.	Есть варианты. Или писать самому, спрашивая что не получается, или заказать готовое и не морочить голову. Я сам — дурнее всякого примера! …

Katerpiller

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

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

10.10.2017 15:21:18

Добрый день!
макрос по своей задаче написала, вывела кнопки управления. вот только не могу прописать, чтобы данное действие исполнялось на всех выбранных мною листах.
в примере часть, 2 из 6 макросов.
можете ли подсказать, пожалуйста, как применять макрос ко всем листам, чтобы не приходилось каждый лист открывать и применять макрос

Код

Sub Разгруппировать()
' Макрос 1
    Columns("A:W").Select
    Selection.Columns.Ungroup
    Columns("A:W").Hidden = False
End Sub

Sub НеделяПервая()
' Макрос 2
Columns("A:W").Select
   Columns("G:H").Select
Columns("A:A").Group
    Selection.Columns("J:U").Group

Изменено: Katerpiller — 11.10.2017 11:07:53

Equio Пользователь Сообщений: 274 Регистрация: 05.05.2016	На всех листах или на выбранных?

Katerpiller Пользователь Сообщений: 5 Регистрация: 25.09.2017	на выбранных. они идут подряд, но следом есть листы с исходными данными, там применять макрос не нужно

Equio

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

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

#10

11.10.2017 15:24:42

Если под выбранными листами имеются в виду несколько выбранных ярлычков с названиями листов внизу окна, то:

Код
For Each sh In ActiveWindow.SelectedSheets sh.Columns("A:W").Ungroup sh.Columns("A:W").Hidden = False Next

Если под выбранными листами имеются в виду листы с определёнными именами, то:

Код

For Each sh In Worksheets(Array("Лист1", "Лист3"))   '  в кавычках через запятую перечисляете имена листов
    sh.Columns("A:W").Ungroup
    sh.Columns("A:W").Hidden = False 
Next

Источник

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!

Источник

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)

Источник

Vhodnoylogin

-12 / 3 / 0

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

Сообщений: 347

Как группировать столбцы правильно?

30.09.2016, 11:45. Показов 4993. Ответов 4

Метки нет (Все метки)

Люди, здравствуйте.

Как группировать столбцы (да и строки). Вот, мне надо сделать в диапазоне несколько группировок. Для этого делаю такую штуку.

Visual Basic

1
2
3

For i = 0 To 7
            Range(.Cells(4, 12 * i + 9 + i), .Cells(4, 12 * (i + 1) + 9)).Columns.Group
     Next i

То есть он должен 8 раз выделить диапазон и сгруппировать его. При этом должны оставаться между ними еще и несгруппированные ячейки.

Но этот гад под названием ВБА просто все группирует под один большой кат. И все. А мне нужно 8. Как это правильно сделать?

KoGG

5590 / 1580 / 406

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

Сообщений: 2,366

Записей в блоге: 1

30.09.2016, 12:03

Гад не VBA.
Не один язык программирования не прощает тупого незнания синтаксиса.
Columns , независимо от того что перед ним, выделяет все столбцы на листе
Columns(«R:Z») -конкретные столбцы

Visual Basic

1	Range(.Cells(4, 12 * i + 9 + i), .Cells(4, 12 * (i + 1) + 9)).EntireColumn.Group

-12 / 3 / 0

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

Сообщений: 347

03.10.2016, 08:09

[ТС]

А как сделать так, чтобы группировка создавалась закрытой, а не открытой? А то мне как-то мало пользы от нее, если ячейки все равно на весь экран растягиваются.

~~Shersh~~

Заблокирован

03.10.2016, 08:24

Сообщение от Vhodnoylogin

чтобы группировка создавалась закрытой, а не открытой?

Никак. Закрывайте после создания (примерно так)

Visual Basic

1	ActiveSheet.Outline.ShowLevels , 1

Vhodnoylogin

-12 / 3 / 0

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

Сообщений: 347

03.10.2016, 15:56

[ТС]

Гууд, благодарю.

Добавлено через 6 часов 54 минуты

Сообщение от Shersh

Закрывайте после создания (примерно так)
ActiveSheet.Outline.ShowLevels , 1

Не работает этот код.
Пишу так

Visual Basic

With wb
        Set ws = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
        ws.name = EXEC_TAB
    End With
With ws
For i = 0 To 7
            Range(.Cells(4, 13 * i + 9), .Cells(4, 13 * (i + 1) + 7)).EntireColumn.Group
        Next i
.Outline.ShowLevels , 1
End With

А группировки все равно развернуты.

Источник

Группировка столбцов по изменяющемуся значению в ячейке

Iren

Дата: Вторник, 16.01.2018, 10:10 |
Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 36

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

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

2010

Доброго дня, уважаемые знатоки VBA!

Подскажите, пожалуйста, как написать код для группировки столбцов с привязкой к значению в ячейке?
Я новичок в VBA и буду благодарна любым идеям для решения данной задачи. Сама я пока не очень уверенно пишу коды — только самые простые комбинации; под конкретные же задачи — теряюсь.

Во вложении файл с нужным результатам на дату 11 января 2018.
Сгруппировать нужно три диапазона в зависимости от изменяющейся даты.

В результате по макросу группировка должна складываться в зависимости от даты в ячейке А1
Пояснения для группировки по столбцам:

1) Диапазон столбцов (H:NH),
— Группировка отсутствует в периоде, который заканчивается датой из ячейки A1, и начинается на 8 столбцов ранее, но не ранее, чем с начала диапазона.
Т.е. если в ячейке А1 окажется дата 4 января 2018 — то без группировки будут 4 первых столбца, соответствующие 1-4 января.
— Столбцы «до» и столбцы «после» несгруппированного периода в диапазоне должны быть сгруппированы и свернуты.

2) Диапазон столбцов (NJ:PJ),
— Группировка отсутствует в период, который заканчивается неделей, содержащей дату из ячейки A1, и начинается на 4 столбца ранее, но не ранее, чем с начала диапазона (NJ:PJ).
Т.е. максимально лишенными группировки в этом диапазоне могут быть 4 столбца, а если это первая неделя января, то 1 столбец.
— Столбцы «до» и столбцы «после» несгруппированного периода в диапазоне должны быть сгруппированы и свернуты.

3) Диапазон столбцов (PL:PW)
— Группировка отсутствует в период, который заканчивается месяцем, содержащим дату из ячейки A1, и начинается на 4 столбца ранее, но не ранее, чем с начала диапазона (PL:PW).
Т.е. максимально лишенными группировки в этом диапазоне могут быть 4 столбца, а если это январь, то 1 столбец.
— Столбцы «до» и столбцы «после» несгруппированного периода в диапазоне должны быть сгруппированы и свернуты.

Заранее спасибо!

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

5282422.xlsm
(65.3 Kb)

Ответить

sboy

Дата: Вторник, 16.01.2018, 11:50 |
Сообщение № 2

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

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

Сообщений: 2566

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

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

Excel 2010

Добрый день.
Вариант без группировок, а просто скрытие ненужных столбцов
[vba]

Код

Sub Ìàêðîñ()

Sheets(1).UsedRange.Columns.Hidden = False

On Error Resume Next

                d = CDate(Right([a1], 10))
            If Err Then
                MsgBox «íå ðàçîáðàë äàòó»
                Err.Clear
                Exit Sub
            End If

        d_ = d — CDate(«01.01.2018»)
        If d_ > 8 Then Range(Cells(1, 8), Cells(1, d_)).EntireColumn.Hidden = True
        If d_ < 372 Then Range(Cells(1, d_ + 9), Cells(1, 372)).EntireColumn.Hidden = True

        w = DatePart(«ww», d, 2, 1) + 373
        If w > 377 Then Range(Cells(1, 373), Cells(1, w — 4)).EntireColumn.Hidden = True
        If w < 426 Then Range(Cells(1, w + 1), Cells(1, 426)).EntireColumn.Hidden = True

            m = Month(d) + 427
        If m > 431 Then Range(Cells(1, 428), Cells(1, m — 4)).EntireColumn.Hidden = True
        If m < 439 Then Range(Cells(1, m + 1), Cells(1, 439)).EntireColumn.Hidden = True

End Sub

[/vba]

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

8980159.xlsm
(68.7 Kb)

Яндекс: 410016850021169

Ответить

Iren

Дата: Вторник, 16.01.2018, 12:34 |
Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 36

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

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

2010

sboy,
Это не совсем подходит, т.к. часто приходится в последствии разворачивать группировки в этом файле. Привыкла к «+».
И почему-то начиная с дат февраля в предложенном Вами варианте скрывается также разделительный серый столбец между днями и неделями, что тоже не очень красиво визуально.

Но за идею спасибо! Попробую довести ее в своем коде до желаемого результата.

Сообщение отредактировал Iren — Вторник, 16.01.2018, 14:00

Ответить

sboy

Дата: Вторник, 16.01.2018, 12:56 |
Сообщение № 4

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

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

Сообщений: 2566

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

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

Excel 2010

Ну тогда держите с плюсиками =)
[vba]

Код

Sub Макрос()
    On Error Resume Next
        ActiveSheet.Outline.ShowLevels ColumnLevels:=2
        Sheets(1).UsedRange.Columns.Ungroup
        If Err Then Err.Clear

                d = CDate(Right([a1], 10))
            If Err Then
                MsgBox «не разобрал дату»
                Err.Clear
                Exit Sub
            End If

        d_ = d — CDate(«01.01.2018») + 8
        If d_ > 15 Then Range(Cells(1, 8), Cells(1, d_ — 8)).EntireColumn.Group
        If d_ < 372 Then Range(Cells(1, d_ + 1), Cells(1, 372)).EntireColumn.Group

        w = DatePart(«ww», d, 2, 1) + 373
        If w > 377 Then Range(Cells(1, 374), Cells(1, w — 4)).EntireColumn.Group
        If w < 426 Then Range(Cells(1, w + 1), Cells(1, 426)).EntireColumn.Group

            m = Month(d) + 427
        If m > 431 Then Range(Cells(1, 428), Cells(1, m — 4)).EntireColumn.Group
        If m < 439 Then Range(Cells(1, m + 1), Cells(1, 439)).EntireColumn.Group

ActiveSheet.Outline.ShowLevels ColumnLevels:=1
End Sub

[/vba]

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

3866028.xlsm
(71.6 Kb)

Яндекс: 410016850021169

Сообщение отредактировал sboy — Вторник, 16.01.2018, 15:58

Ответить

Iren

Дата: Вторник, 16.01.2018, 14:00 |
Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 36

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

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

2010

sboy,

Второй вариант — идеально! specool

Большое Вам спасибо!!!

Ответить

Iren

Дата: Четверг, 18.01.2018, 12:23 |
Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 36

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

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

2010

Подскажите, пожалуйста!

Работая с выше указанным кодом, попыталась уйти от On Error Resume Next, т.к. пока опыт небольшой, боюсь пропускать ошибки … мало ли что…
Заменила
[vba]

Код

Sheets(1).UsedRange.Columns.Ungroup
If Err Then Err.Clear

[/vba]
на
[vba]

Код

Dim r_of_days As Range
Set r_of_days = Range(«H:PW»)
While r_of_days.EntireColumn.OutlineLevel > 1
r_of_days.EntireColumn.Ungroup
Wend

[/vba]

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

Где я ошиблась?

Сообщение отредактировал Iren — Четверг, 18.01.2018, 12:44

Ответить

Karataev

Дата: Четверг, 18.01.2018, 13:25 |
Сообщение № 7

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

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

Сообщений: 1330

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

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

Excel

Можно окружать в обработчик ошибок фрагмент кода, где ожидается ошибка. И если возникнет непредвиденная ошибка в другом месте, Вы об этом узнаете.

Киви-кошелек: 9166309108

Ответить

Karataev

Дата: Четверг, 18.01.2018, 13:55 |
Сообщение № 8

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

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

Сообщений: 1330

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

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

Excel

…

Киви-кошелек: 9166309108

Сообщение отредактировал Karataev — Четверг, 18.01.2018, 17:04

Ответить

Iren

Дата: Четверг, 18.01.2018, 14:05 |
Сообщение № 9

Группа: Пользователи

Ранг: Новичок

Сообщений: 36

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

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

2010

Спасибо! Полезно узнать про On Error GoTo 0

Но что все-таки не так у меня с While?
Может, какие-то ограничения есть, когда задается цикл?
Чтобы мне понимать, в каких случаях можно пользоваться while, и с чем while не работает.

Ответить

Karataev

Дата: Четверг, 18.01.2018, 14:18 |
Сообщение № 10

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

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

Сообщений: 1330

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

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

Excel

Откуда Вы «откопали» While — Wend. Если Вы только начинаете изучать VBA. то в современных справочниках не упоминается этот цикл. Было бы понятно, если Вы начали программировать лет 20 назад. Сейчас используются Do — Loop.

Киви-кошелек: 9166309108

Сообщение отредактировал Karataev — Четверг, 18.01.2018, 17:04

Ответить

Iren

Дата: Четверг, 18.01.2018, 14:38 |
Сообщение № 11

Группа: Пользователи

Ранг: Новичок

Сообщений: 36

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

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

2010

Karataev,

Не совсем: Sub Разгруппировать() снимает только один уровень группировки столбцов, а не все.
Я хотела полностью очистить столбцы области (H:PW) от всех группировок, чтобы цикл проверял диапазон снова и снова, до тех пор, пока уровень группировки>1

Ответить

Karataev

Дата: Четверг, 18.01.2018, 14:47 |
Сообщение № 12

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

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

Сообщений: 1330

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

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

Excel

…

Киви-кошелек: 9166309108

Сообщение отредактировал Karataev — Четверг, 18.01.2018, 17:05

Ответить

Iren

Дата: Четверг, 18.01.2018, 15:21 |
Сообщение № 13

Группа: Пользователи

Ранг: Новичок

Сообщений: 36

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

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

2010

Цитата

Макрос из поста 8 удаляет группировку в столбцах «H:PW».

удаляет один уровень группировки, а если уровней вдруг окажется больше (например, 3,4 случайный пользователь файла наставит), то не подходит.

А в макросе из поста №10 у меня баг выдает в строке кода:
[vba]

Код

If r_of_days.Columns(c).OutlineLevel <> 1 Then

[/vba]
Пишет, что приложение или объект не определены.
А после нажатия «End» код идет дальше и заканчивает работу правильно.

Сообщение отредактировал Iren — Четверг, 18.01.2018, 15:27

Ответить

Iren

Дата: Четверг, 18.01.2018, 15:26 |
Сообщение № 14

Группа: Пользователи

Ранг: Новичок

Сообщений: 36

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

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

2010

Цитата

PS. Откуда Вы «откопали» While — Wend.

Месяца два назад начала изучать VBA с нуля по учебнику из интернета. Наверное, это был очень старый учебник) Но просто и понятно написанный. А теперь вот пытаюсь практиковаться.

Ответить

Karataev

Дата: Четверг, 18.01.2018, 15:32 |
Сообщение № 15

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

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

Сообщений: 1330

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

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

Excel

Можно так удалить группировку:
[vba]

Код

Sub Разгруппировать()
    Dim r_of_days As Range
    Set r_of_days = Range(«H:PW»)
    r_of_days.ClearOutline
End Sub

[/vba]
PS. Ясно, буду теперь знать, откуда берутся старые приемы — из статей интернета.

Киви-кошелек: 9166309108

Ответить

Iren

Дата: Четверг, 18.01.2018, 15:39 |
Сообщение № 16

Группа: Пользователи

Ранг: Новичок

Сообщений: 36

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

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

2010

ClearOutline категорически нельзя — в моих файлах есть еще и сложная группировка строк бывает.

Ответить

sboy

Дата: Четверг, 18.01.2018, 15:41 |
Сообщение № 17

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

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

Сообщений: 2566

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

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

Excel 2010

Поэтому я и предлагал в самом начале скрывать столбцы, а не группировать

Яндекс: 410016850021169

Ответить

Karataev

Дата: Четверг, 18.01.2018, 15:51 |
Сообщение № 18

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

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

Сообщений: 1330

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

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

Excel

Ещё способ, как разгруппировать:
[vba]

Код

Sub Разгруппироать()
    Dim r_of_days As Range
    Set r_of_days = Columns(«H:PW»)
    r_of_days.OutlineLevel = 1
End Sub

[/vba]

Киви-кошелек: 9166309108

Ответить

Iren

Дата: Четверг, 18.01.2018, 16:03 |
Сообщение № 19

Группа: Пользователи

Ранг: Новичок

Сообщений: 36

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

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

2010

Цитата

Поэтому я и предлагал в самом начале скрывать столбцы, а не группировать

Уважаемые, но задача-то сделать макрос, удобный для использования — такой, чтобы привычные ручные действия автоматизировать — а не подстраиваться под код.
Работать удобнее и привычнее с группировками, а не со скрытыми столбцами.

Если, вариантов без On Error Resume нет, то вернусь к макросу из поста 4 и добавлю предложенный On Error Go to 0
Решение-то уже есть — код sboy.
Извиняюсь, если назойлива: мне как новичку было интересно готовый код разобрать вдоль и поперек и максимально понять как он работает и как сделать аналог известными мне операторами, чтобы в дальнейшем мочь что-то самой.

Ответить

Karataev

Дата: Четверг, 18.01.2018, 16:05 |
Сообщение № 20

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

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

Сообщений: 1330

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

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

Excel

В посте 4 макрос не удаляет все уровни группировки.

Киви-кошелек: 9166309108

Ответить

Источник