sergey_sasin, здравствуйте. У вас нумерация идёт по уровню группировки. При добавлении новых данных, как макросу понимать, что и как нумеровать? Или вы группировать сами будете, а потом запускать макрос? С заливкой то же самое… Я в таких случаях поступаю от обратного: делаю классическую плоскую "умную" таблицу с полями № КАТ, категория, № ГР, группа, № РАБ, работа (в полях с № числа в общем формате). Затем сцепляю в нужном порядке и анализирую в сводной. Потом строю отчёт в любом виде (в том числе и таком).
Макросы для нумерации по моему методу прикрепляю. Текстовый поля (категория, группа, работа и т.д.) должны быть отсортированы (категория->группа->работа)
3 макроса |
---|
Код |
---|
'Нумерация РАБОТ в группах по порядку
'Описание: Индексирует в Selection РАБОТЫ по ГРУППАМ, согласно текущей сортировки
'Процесс: Указывается столбец групп (средний уровень группировки)
'Автор: Jack Famous
'Тема на форуме: http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=61888&TITLE_SEO=61888-makros-numeratsii-bez-skrytykh-yacheek
'=================================================================================================================================================
Sub IndexWorksByGroups()
Dim GrRng As Range
Dim i As Long
Dim группа As Long
Dim выбор As Long
Dim начало As Long
Dim конец As Long
'группа = InputBox("Введите № столбца группировки")
Set GrRng = Application.InputBox("Укажите любую ячейку столбца ГРУПП:", "Запрос данных.", , Type:=8).Cells(1)
группа = GrRng.Column
выбор = Selection.Column
начало = Selection.Row + 1
конец = Selection.Row + Selection.Rows.Count - 1
Application.ScreenUpdating = 0
Cells(Selection.Row, выбор).Value = 1
For i = начало To конец
If Cells(i, группа).Value = Cells(i - 1, группа).Value Then
Cells(i, выбор).Value = Cells(i - 1, выбор).Value + 1
Else
Cells(i, выбор).Value = 1
End If
Next
Application.ScreenUpdating = 1
End Sub
'=================================================================================================================================================
'Нумерация ГРУПП ячеек в столбце по порядку
'Описание: Индексирует в Selection ГРУППЫ по КАТЕГОРИЯМ, согласно текущей сортировки
'Процесс: Указывается столбец категорий (верхний уровень группировки) и столбец групп (средний уровень группировки)
'Автор: Jack Famous
'Тема на форуме: http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=86838&TITLE_SEO=86838-numeratsiya-unikalnykh-znacheniy-s-uchyetom-kategoriy
'======================================================================================================================================================================================
Sub IndexGroupsByCategories()
Dim iCatRng As Range
Dim iGrRng As Range
Dim i As Long
Dim категория As Long
Dim группа As Long
Dim выбор As Long
Dim начало As Long
Dim конец As Long
'категория = InputBox("Введите № столбца категорий")
'группа = InputBox("Введите № столбца групп")
Set CatRng = Application.InputBox("Укажите любую ячейку столбца КАТЕГОРИЙ:", "Запрос данных.", , Type:=8).Cells(1)
Set GrRng = Application.InputBox("Укажите любую ячейку столбца ГРУПП:", "Запрос данных.", , Type:=8).Cells(1)
категория = CatRng.Column
группа = GrRng.Column
выбор = Selection.Column
начало = Selection.Row + 1
конец = Selection.Row + Selection.Rows.Count - 1
Application.ScreenUpdating = 0
Cells(Selection.Row, выбор).Value = 1
For i = начало To конец
If Cells(i, категория).Value <> Cells(i - 1, категория).Value Then
Cells(i, выбор).Value = 1
ElseIf Cells(i, группа).Value = Cells(i - 1, группа).Value Then
Cells(i, выбор).Value = Cells(i - 1, выбор).Value
Else: Cells(i, выбор).Value = Cells(i - 1, выбор).Value + 1
End If
Next
Application.ScreenUpdating = 1
End Sub
'=================================================================================================================================================
'Нумерация КАТЕГОРИЙ в столбце по порядку
'Описание: Индексирует в Selection КАТЕГОРИИ, согласно текущей сортировки
'Процесс: Указывается столбец категорий (верхний уровень группировки) и столбец групп (средний уровень группировки)
'Автор: Jack Famous
'Тема на форуме: http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=86838&TITLE_SEO=86838-numeratsiya-unikalnykh-znacheniy-s-uchyetom-kategoriy
'======================================================================================================================================================================================
Sub IndexCategories()
Dim CatRng As Range
Dim i As Long
Dim категория As Long
Dim выбор As Long
Dim начало As Long
Dim конец As Long
'категория = InputBox("Введите № столбца категорий")
Set CatRng = Application.InputBox("Укажите любую ячейку столбца КАТЕГОРИЙ:", "Запрос данных.", , Type:=8).Cells(1)
категория = CatRng.Column
выбор = Selection.Column
начало = Selection.Row + 1
конец = Selection.Row + Selection.Rows.Count - 1
Application.ScreenUpdating = 0
Cells(Selection.Row, выбор).Value = 1
For i = начало To конец
If Cells(i, категория).Value = Cells(i - 1, категория).Value Then
Cells(i, выбор).Value = Cells(i - 1, выбор).Value
Else: Cells(i, выбор).Value = Cells(i - 1, выбор).Value + 1
End If
Next
Application.ScreenUpdating = 1
End Sub
|
|