Автоматический подсчет задач, перемещение, нумерация.

Автоматический подсчет активных задач

Определившись со структурой Планеро, переходим к автоматизации рабочего процесса и первым делом сделаем автоматический подсчёт активных задач на листах «Входящие», «Проекты», «Отложенные», «Периодическое». Для реализации этой задачи воспользуемся стандартной функцией Excel’я СЧЁТЗ, подсчитывающей количество заполненных ячеек. Разместим её в ячейке «I1» каждого листа в виде «=СЧЁТЗ(B:B)-1», подсчитывающая количество заполненных ячеек в столбце «В» минус одно значение, которое приходится на название шапки таблицы «Наименование задачи».

Формула подсчета активных задач
Автоматически подсчитываем активные задачи

Реализация кнопки «Разобрать папку Входящие»

С целью оперативного распределения поступивших задач из вкладки «Входящие» по соответствующим листам, реализуем автоматическое отображение кнопки «Разобрать папку Входящие» с указанием количества необработанных поручений.

Для этой цели воспользуемся стандартными функциями экселя: «ЕСЛИ; СЧЁТЗ». В ячейку «H2» добавим формулу следующего вида:

=ЕСЛИ(СЧЁТЗ(Входящие!$B:$B)-1>0;"Разобрать папку Входящие - " & СЧЁТЗ(Входящие!$B:$B)-1 & "шт.";"")

Формула подсчитывает количество активных задач и если оно больше нуля – записывает в ячейку текст: "Разобрать папку Входящие - " & СЧЁТЗ(Входящие!$B:$B-1) & "шт.". Апостроф «&» предназначен для склеивания подстрок в одну строку.

Также к ячейке «H2» применим условное форматирование с выделением цветом и границ ячейки в том случае, если ячейка содержит текст «Разобрать папку Входящие».

Теперь при наличии неотработанных задач на листе «Входящие» кнопка будет автоматически отображаться на листе «Главная» и наоборот в случае отсутствия задач, кнопка будет скрыта.

Чтобы при нажатии на кнопку автоматически открывался лист «Входящие» напишем макрос в процедуре Sub Worksheet_SelectionChange(ByVal Target As Range) главного листа:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Нажатие на кнопку "Разобрать папку Входящие" при условии что она есть
If ActiveCell.Column = 8 And ActiveCell.Row = 2 And InStr(1, Cells(ActiveCell.Row, ActiveCell.Column).Value, "Разобрать папку Входящие") > 0 Then
' убираем курсор с кнопки
Workbooks("planero.xlsm").Worksheets("Главная").Range("B3").Select
' делаем лист "Входящие" активным
Workbooks("planero.xlsm").Worksheets("Входящие").
' переводим курсор на первую позиции листа "Входящие"
Workbooks("planero.xlsm").Worksheets("Входящие").Range("A3").Select
End If
End Sub

Наглядно работоспособность кнопки выглядит следующим образом:

Работа кнопки «Разобрать папку Входящие»
Проверка работоспособности кнопки

Быстрое перемещение по листам

Для владения оперативной информацией о состоянии списков на листах «Проекты», «Отложенные», «Периодическое», а также быстрого перемещения между ними разместим на главной странице соответствующие кнопки с отображением количества активных задач, воспользовавшись функциями «СЦЕПИТЬ и ЕСЛИ»:

=СЦЕПИТЬ("Входящие";ЕСЛИ(Входящие!$I$1>0;СЦЕПИТЬ(" (";Входящие!$I$1;")");""))

=СЦЕПИТЬ("Проекты";ЕСЛИ(Проекты!$I$1>0;СЦЕПИТЬ(" (";Проекты!$I$1;")");""))

=СЦЕПИТЬ("Отложенные";ЕСЛИ(Отложенные!$I$1>0;СЦЕПИТЬ(" (";Отложенные!$I$1;")");""))

=СЦЕПИТЬ("Периодическое";ЕСЛИ(Периодическое!$I$1>0;СЦЕПИТЬ(" (";Периодическое!$I$1;")");""))

Функция СЦЕПИТЬ соединяет несколько строк в одну. На примере кнопки Входящие, итоговая строка будет состоять из 4-х отдельных строк: «Входящие» + « (» + Количество задач + «) ».

Также на каждом листе разместим кнопку «Главная» в ячейке «М2». И ко всем вновь созданным кнопкам применим соответствующее форматирование.

Кнопки на главной странице

Кнопка «Главная» на остальных страницах

Для реализации автоматического открытия соответствующего листа при нажатии на созданные кнопки, напишем макрос в процедуре Sub Worksheet_SelectionChange(ByVal Target As Range) главного листа:

' Входящие
If ActiveCell.Column = 10 And ActiveCell.Row = 2 And InStr(1, Cells(ActiveCell.Row, ActiveCell.Column).Value, "Входящие") > 0 Then
' убираем курсор с кнопки
Workbooks("planero.xlsm").Worksheets("Главная").Range("B3").Select
' делаем лист "Входящие" активным
Workbooks("planero.xlsm").Worksheets("Входящие").Select
' переводим курсор на первую позиции листа "Входящие"
Workbooks("planero.xlsm").Worksheets("Входящие").Range("A3").Select
End If

' Проекты
If ActiveCell.Column = 10 And ActiveCell.Row = 4 And InStr(1, Cells(ActiveCell.Row, ActiveCell.Column).Value, "Проекты") > 0 Then
' убираем курсор с кнопки
Workbooks("planero.xlsm").Worksheets("Главная").Range("B3").Select
' делаем лист "Проекты" активным
Workbooks("planero.xlsm").Worksheets("Проекты").Select
' переводим курсор на первую позиции листа "Проекты"
Workbooks("planero.xlsm").Worksheets("Проекты").Range("A3").Select
End If

' Отложенные
If ActiveCell.Column = 10 And ActiveCell.Row = 6 And InStr(1, Cells(ActiveCell.Row, ActiveCell.Column).Value, "Отложенные") > 0 Then
' убираем курсор с кнопки
Workbooks("planero.xlsm").Worksheets("Главная").Range("B3").Select
' делаем лист "Отложенные" активным
Workbooks("planero.xlsm").Worksheets("Отложенные").Select
' переводим курсор на первую позиции листа "Отложенные"
Workbooks("planero.xlsm").Worksheets("Отложенные").Range("A3").Select
End If

' Периодическое
If ActiveCell.Column = 10 And ActiveCell.Row = 8 And InStr(1, Cells(ActiveCell.Row, ActiveCell.Column).Value, "Периодическое") > 0 Then
' убираем курсор с кнопки
Workbooks("planero.xlsm").Worksheets("Главная").Range("B3").Select
' делаем лист "Периодическое" активным
Workbooks("planero.xlsm").Worksheets("Периодическое").Select
' переводим курсор на первую позиции листа "Периодическое"
Workbooks("planero.xlsm").Worksheets("Периодическое").Range("A3").Select
End If

И соответствующей процедуре каждого листа:

' Главная
If ActiveCell.Column = 13 And Cells(ActiveCell.Row, ActiveCell.Column).Value = "Главная" And ActiveCell.Row = 2 Then
' убираем курсор с кнопки
Workbooks("planero.xlsm").Worksheets("Периодическое").Cells(ActiveCell.Row, ActiveCell.Column - 4).Select
' делаем лист "Главная" активным
Workbooks("planero.xlsm").Worksheets("Главная").Select
' переводим курсор на ячейку А1 листа "Главная"
Workbooks("planero.xlsm").Worksheets("Главная").Range("A1").Select
End If

Автоматическая нумерация с форматированием задач и подзадач

На стадии распределения входящих задач по соответствующим вкладкам «Проекты», «Отложенные», «Периодическое» приходится выполнять ручную нумерацию пунктов и подпунктов каждой задачи, что естественно муторно. Хотелось бы сделать так, чтобы эти номера появлялись автоматически. И для этого сначала сделаем кнопку «Обновить» в ячейке «K2» каждого листа. После в процедуру Sub Worksheet_SelectionChange(ByVal Target As Range) листа «Периодическое» добавим макрос, подробно рассмотренный в статье «Автоматическая нумерация строк в Excel с помощью VBA».

' Обновить
If ActiveCell.Column = 11 And Cells(ActiveCell.Row, ActiveCell.Column).Value = "Обновить" And ActiveCell.Row = 2 Then
' ссылка на лист
Set pr = Workbooks("planero.xlsm").Worksheets("Периодическое")
i = 0' для цикла
j = 1' номер, с которого начинать отсчёт

' проходим вниз по строкам, пока в них есть данные
Do While pr.Range("B3").Offset(i, 0) > 0 Or pr.Range("C3").Offset(i, 0) > 0
' если ячейка B(3+i) не пустая
If pr.Range("B3").Offset(i, 0) > 0 Then
' добавляем номер в ячейку A(3+i)
pr.Range("A3").Offset(i, 0) = j
' увеличиваем номер на 1
j = j + 1
End If
' переходим к следующей ячейке
i = i + 1
Loop
' убираем курсор с кнопки
pr.Cells(ActiveCell.Row, ActiveCell.Column - 2).Select
End If

Также добавим аналогичный код на листы «Отложенные», «Входящие» изменив строку Set pr = Workbooks("planero.xlsm").Worksheets("Имя_Листа") под соответствующее имя.

А вот на лист «Проекты» код необходимо доработать в части нумерации задач и подзадач.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Обновить нумерацию
If ActiveCell.Column = 10 And Cells(ActiveCell.Row, ActiveCell.Column).Value = "Обновить нумерацию" And ActiveCell.Row = 2 Then
' ссылка на лист книги в котором обновляем нумерацию
Set pr = Workbooks("planero-s-avtomaticheskoj-numeraciej-strok.xlsm").Worksheets("Проекты")
i = 0 ' для работоспособности цикла
j = 1 ' номер задачи
k = 1 ' номер подзадачи
' проходим вниз по странице до тех пор, пока есть записи в ячейке "B3" или "C3"
Do While pr.Range("B3").Offset(i, 0) > 0 Or pr.Range("D3").Offset(i, 0) > 0
' если ячейка "В3"+i содержит текст
If pr.Range("B3").Offset(i, 0) > 0 Then
' нумеруем ее
pr.Range("A3").Offset(i, 0) = j
' выделяем номер жирным
pr.Range("A3").Offset(i, 0).Font.Bold = True
pr.Range("B3").Offset(i, 0).Font.Bold = True
' увеличиваем переменную j на единицу
j = j + 1
' обнуляем номер подзадачи
k = 1
' если ячейка "B3"+i пустая, следовательно мы имеем дело с подзадачей
Else
' если ячейка "D3"+i содержит текст
If pr.Range("D3").Offset(i, 0) > 0 Then
' нумеруем ее
pr.Range("C3").Offset(i, 0) = k
' увеличиваем номер подзадачи на единицу
k = k + 1
End If
End If
' увеличиваем i на +1 чтобы проверить следующию ячейку (расположенную ниже) на наличие записи
i = i + 1
Loop
' убираем курсор с кнопки
pr.Cells(ActiveCell.Row, ActiveCell.Column - 2).Select
End If
End Sub

На итог получим автоматическую нумерацию по нажатию кнопки «Обновить»:

Нумерация с помощью VBA
Автоматическая нумерация с помощью макроса

В следующей статье рассмотрим реализацию макроса подсчета выполненных и не выполненных пунктов на странице «Проекты» с указанием процента выполнения задачи в целом. Это даст наглядность и чувство прогресса.

Актуальная версия Планеро доступна по ссылке.

Поделись с друзьями:
Комментарии 2

Марьяна Захарова
09 сентября 2020 в 08:21
Статья очень полезная, все грамотно расписано, вполне удобно в использовании оперативной информацией о состоянии списков на листах, удобно получаем автоматическую нумерацию.
© планеро.ru