Печатаем график работы для списка сотрудников на выбранную дату
Введение
Мы решили сделать обзорное видео и показать Вам один из вариантов настройки автоматической печати рабочего графика в Excel. Представьте себе ситуацию: с определенной периодичностью Вы формируете рабочий график для своих сотрудников в Excel, после чего, Вам необходимо распечатать эти графики для каждого сотрудника на каждый день. Что Вы будете делать?
Скорее всего, приметесь фильтровать данные по сотруднику и дате, после выделять этот диапазон и отправлять на печать. И так по каждому сотруднику. И так за каждый день. Представили? Да, выходит довольно рутинная задачка. Как избавиться от рутины данной ситуации, мы и поговорим далее.
Скачать файл из этой статьи
Обзорное видео смотрите ниже. Приятного просмотра!
Автоматизация печати в Excel
В современном мире для работы по-прежнему нужно прогонять через принтер горы бумаги. Если Вы ежедневно сталкиваетесь с печатью большого количества бланков, договоров, графиков, планов и т.п. в Excel, то пришла пора задуматься об автоматизации этого процесса.
Мы покажем пример автоматической печати сменного рабочего графика на примере розничного магазина одежды. Аналогичные сменные рабочие графики используются в различных сферах, вроде строительства, производства или медицины.
Исходные данные
Имеется таблица, где формируется рабочий график.
График работы магазина с 10:00 до 22:00. В столбцах:
А – даты
В – операции
С – сотрудники
D-AB – занятость в минутах (интервал 30 минут)
AC – общая загруженность в % (8 часов - 100%). Рассчитывается как сумма занятости по операции деленная на 480
AD – общая загруженность в часах (8 часов - максимальная загруженность). Рассчитывается как сумма занятости по операции деленная на 60
Приводим лист к нужному виду
Первым делом сделаем из нашего диапазона «умную» таблицу Excel. Делается это сочетанием клавиш Ctrl+T.
Теперь, при добавлении новой даты, диапазон нашей таблицы будет автоматически растягиваться.
Для того, чтобы было удобнее отслеживать загруженность сотрудника, создадим сводную таблицу и на ее основе построим сводную диаграмму, которую разместим на текущем листе.
Вставка -> Сводная таблица -> На новый лист
Поля сводной таблицы на рисунке ниже.
Результат сводной таблицы:
Далее вкладка «Анализ» -> Сводная диаграмма
Выбираем обычную гистограмму.
Настроим ее форматирование на свой вкус и перенесем на лист рядом с рабочим графиком.
Такая диаграмма позволяет оперативно отслеживать загруженность сотрудников за день.
Справа от гистограммы создаем список сотрудников. В ячейке AQ2 прописываем формулу =ЕСЛИ(AR2=ИСТИНА;1;0) и копируем ее на ячейки ниже. Форматированием скрываем видимость результата в столбце AQ (устанавливаем белый цвет шрифта).
Рядом в колонку AQ добавляем флажки, а также формируем шаблон для выбора дат. Именно здесь мы и будем указывать для каких сотрудников и на какие даты нам требуется напечатать рабочий график.
Флажки связываем со столбцом AR.
Из списка сотрудников создаем выпадающие списки в «умной» таблице (для удобства заполнения).
Далее, для того чтобы не вводить даты вручную, а брать их из введенных значений, нам потребуется создать список уникальных дат из таблицы.
Из списка имеющихся дат создаем именованный диапазон с именем «Исходный».
Далее добавляем новый столбец перед столбцом с датами, назовем его «Уникальные даты» и добавим в диапазон таблицы.
В ячейку А2 вставляем формулу массива: =ЕСЛИОШИБКА(ИНДЕКС(Исходный;ПОИСКПОЗ(СУММ(СЧЁТЕСЛИ(A$1:A1; Исходный));СЧЁТЕСЛИ(Исходный;"<"& Исходный);0));"")
Копируем формулу на ячейки ниже и задаем формат «Дата».
Далее создаем именованный диапазон:
Имя: «Даты»
Диапазон: =СМЕЩ('График рабочих смен'!$A$2;0;0;СЧЁТЗ(Таблица1[Уникальные даты])-СЧИТАТЬПУСТОТЫ(Таблица1[Уникальные даты]))
Полученный именованный диапазон «Даты» используем в качестве источника для списка в столбцах AT.
Настраиваем подсказку по вводу:
Скрываем столбец А. В целом все готово для автоматизации печати.
Сохраняем книгу как файл с поддержкой макросов (xlsm).
Сочетанием клавиш Alt+F11 попадаем в окно Visual Basic.
Создаем два новых модуля: Insert – Module
В первый модуль вставляем код:
Public Sub Filter()
'Проверяем что сотрудник и дата для печати выбраны'
If Application.Sum(Range("AR2:AR13")) = 0 Or Application.Sum(Range("AT2:AT8")) = 0 Then
MsgBox ("Выберите сотрудника и дату")
Else
'Цикл пробегающий по списку сотрудников'
For s = 2 To 14 Step 1
'Условие для выбора сотрудника'
If Range("AR" + CStr(s)) = 1 Then
Set tbl = [A1].CurrentRegion
tbl.AutoFilter Field:=4, Criteria1:=Range("AQ" + CStr(s))
'Подсчет указанных дат'
ndate = Application.WorksheetFunction.CountA(Columns(46)) - 1
'Цикл пробегающий по всем датам'
For i = 1 To ndate Step 1
Set tbl = [A1].CurrentRegion
tbl.AutoFilter Field:=2, Criteria1:="=" & Format(Range("AT" + CStr(2 + i - 1)), "dd.mm.yy")
'Определяем последнюю видимую строку в фильтре по столбцу с фамилией сотрудника'
LastRow = ActiveSheet.Cells(1, 4).SpecialCells(xlLastCell).Row
'Проверяем наличие графика на протяжении всего кода'
If LastRow = 1 Then
MsgBox ("Рабочий график отсутствует")
Else
'Копируем таблицу'
Range(Cells(1, 2), Cells(LastRow, 31)).Select
Selection.Copy
'Создаем новую книгу'
Workbooks.Add
'Вставляем таблицу в ячейку A5'
Range("A5").Select
ActiveSheet.Paste
'Добавляем основную информацию'
Application.ScreenUpdating = False
Range("A1").FormulaR1C1 = "Дата"
Range("A2").FormulaR1C1 = "Сотрудник"
Range("A3").FormulaR1C1 = "Время"
Range("B1").FormulaR1C1 = "=R[5]C[-1]"
Range("B2").FormulaR1C1 = "=R[4]C[1]"
Range("B1:B2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
'Считаем количество непустых столбцов'
a = 1
For c = 4 To 28 Step 1
If Application.Sum(Range(Cells(6, c), Cells(25, c))) <> 0 Then
a = a + 1
End If
Next c
a = a - 1 'Убираем лишнюю исходную a'
'Цикл пробегающий по всему времени от 4 столбца до 4+CountCell'
For y = 4 To a + 4 Step 1
'Подсчет корректности графика во времени'
n = Application.WorksheetFunction.CountA(Columns(y))
If n = 1 Then
Columns(y).Delete
y = y - 1
End If
Next y
'Указываем итоговое рабочее время'
Range("B3") = Cells(5, 4)
Range("C3") = Cells(5, 3 + a)
Range("B3:C3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Проверяем наличие загруженности'
If Range("B3") = "Общая загруженность (%)" Or Range("C3") = "Операция" Then
Range("B3") = "Без загрузки"
Range("C3").ClearContents
End If
'Подбираем автоматически ширину для столбцов'
Columns("A:AJ").EntireColumn.AutoFit
'Запускаем макрос сортировки'
Call Sort
'номер последнего столбца'
lastCol = Cells(6, Columns.Count).End(xlToLeft).Column
'номер последней строки'
LastRow = Cells(Rows.Count, lastCol).End(xlUp).Row
'Подсчитываем, сколько строк должно остаться'
ActiveSheet.Range(Cells(6, lastCol), Cells(LastRow, lastCol)).Select
CountRow = WorksheetFunction.CountIf(Range(Cells(6, lastCol), Cells(LastRow, lastCol)), "<>0")
'Удаляем лишние строки (где Общая загруженность (%) = 0)'
For Q = 6 To 6 + CountRow Step 1
If Cells(Q, lastCol) = 0 Then
Rows(Q).Delete
'Если все лишние нули удалены, то останавливаем цикл'
If CountRowlastCol = CountRow Then
Q = 6 + CountRow
Else
Q = Q - 1
End If
End If
'Подсчитываем, сколько строк сейчас в последнем столбце'
CountRowlastCol = WorksheetFunction.CountA(Range(Cells(6, lastCol), Cells(25, lastCol)))
Next Q
'Отправляем на предварительный просмотр перед печатью'
'Вписываем на 1 лист'
Application.PrintCommunication = False
ActiveSheet.PageSetup.FitToPagesWide = 1
Application.PrintCommunication = True
'Горизонтальная страница'
ActiveSheet.PageSetup.Orientation = xlLandscape
'Предпросмотр'
ActiveSheet.PrintPreview
'Отправляем на печать'
ActiveWorkbook.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
ActiveWindow.Close False
Windows("automatic-printing.xlsm").Activate
End If 'Закрываем проверку на наличие графика'
Next i 'Переходим к следующей дате'
Else: s = s
End If
Next s
'Очищаем фильтр'
Range("Таблица1[[#Headers]]").Activate
ActiveSheet.ShowAllData
'Удаляем лишнее'
Range("AT2:AT8").ClearContents
Range("AS2:AS13") = False
End If
End Sub
Во второй модуль вставляем код:
Sub Sort()
'Сортировкой по цвету (розовый) упорядочиваем строки от конца до начала'
Rows("5:5").AutoFilter
ActiveSheet.AutoFilter.Sort.SortFields.Clear
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("D6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("E6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("F6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("G6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("H6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("I6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("J6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("K6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("L6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("M6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("N6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("O6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("P6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("Q6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("R6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("S6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("T6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("U6" _
), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
, 199, 206)
With ActiveSheet.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
End Sub
Сохраняем изменения. Последний штрих – создаем кнопку «Печать» и присваиваем ей макрос Filter.
Готово! Выбираем сотрудников, даты и жмем печать. График по каждому сотруднику генерируется автоматически и идет на печать. При необходимости все сменные графики можно сохранять в отдельной папке на вашем устройстве. Изменение структуры листа с графиком влечет за собой изменение в приложенном коде.
Заключение
Данный пример демонстрирует возможность быстро формировать и отправлять на печать рабочие графики выбранных сотрудников за конкретный день или сразу за неделю. Пользуйтесь готовым файлом, изменив в нем список сотрудников и тип операций, или адаптируйте его под свои задачи.
Нужна помощь в Excel или Google Sheets? Свяжитесь с нами, обсудим все детали.
Оперативно решаем любую проблему в Excel и Google таблицах:
- Написание формул любой сложности
- Создание сводных таблиц
- Визуализация данных (диаграммы, гистограммы)
- Автоматизация расчётов и рутинных задач
- Консультации по работе с таблицами и многое другое