В решаемой задаче учета грузоперевозок необходимо вести журнал перевозок (рис. 1), а также начислять оплату водителям, выполняющим перевозки.
Рис. 1. Журнал перевозок
В журнале отображаются следующие сведения:
В ячейках столбца Количество проставляется единица, поэтому Сумма, равная Количество * Цена, совпадает с ценой. Оплата водителя вычисляется по следующей формуле:
Оплата = Коэффициент * Сумма,
где Коэффициент – это число, меньшее 1, задаваемое на листе Водители.
Период журнала перевозок равен одной неделе. После завершения недели на листе Оплата фиксируются недельные доходы водителей, журнал очищается и перевозки новой недели заносятся с чистого листа.
Задача разработки в том, чтобы осуществить заполнения журнала перевозок, путем добавления сведений о клиентах, маршрутах и водителях из соответствующих справочников. Кроме того, нужно автоматизировать и заполнение журнала понедельных выплат водителям (рис. 2).
Рис. 2. Журнал понедельных выплат водителям
Эти задачи реализуются средствами Excel и Microsoft Visual Basic.
Приложение имеет 7 листов (рис. 3).
Рис. 3. Рабочие листы приложения
На листе Неделя указывается номер текущей недели. Значение номера увеличивается в начале недели на единицу. Таким образом, номер недели – это продолжительность ведения учета грузоперевозок в неделях.
На листе Перевозки ведется журнал перевозок (см. рис. 1). Кнопки Клиент, Маршрут и Водитель активизируют лист приложения (рис. 4) с соответствующей справочной информацией.
Рис. 4. Листы Клиенты, Маршруты и Водители
Расположенные на этих листах кнопки Выбрать осуществляют перенос выбранной записи с текущего листа в журнал перевозок.
После нажатия на кнопку Дата+ журнала перевозок в выбранную ячейку с датой устанавливает увеличенное на единицу значение вышележащей ячейки.
После нажатия на кнопку Копия в выбранную ячейку копируется значение вышележащей ячейки.
После ввода всех недельных перевозок на листе Оплата (см. рис. 2) нажимается кнопка Расчет. Запускаемый одноименный макрос формирует сводные недельные выплаты водителям.
Сначала данные, формируемые этим макросом, накапливаются на листе wrk (рис. 5).
Рис. 5. Расчет начислений на листе wrk
В столбцах A и B листа wrk располагается отсортированный список недельных начислений. Затем по этому списку в столбцах E, F и G формируется ведомость недельных начислений, а под ними – итоговая сумма выплат. Далее столбцы E, F и G переносятся на лист Оплата.
Данные о недельных перевозках вводятся по следующей схеме:
Приложение работает, если его некоторые листы содержат следующие специальные символы:
# в столбце Клиент журнала перевозок (см. рис. 1);
$ в столбце Маршрут того же журнала;
& в столбце Водитель того же журнала;
@ в столбце Неделя журнала понедельных выплат (см. рис. 2).
Эти символы должны находиться сразу после последней введенной перевозки. При отсутствии перевозок символы размещаются в 4-й строке листа Перевозки.
Наличие символов в указанной строке листа Перевозки проверяется функцией checkSmbls (код см. ниже).
В случае журнала перевозок по имеющимся в нем символам определяется начало вставки соответствующей порции данных. Так, на место символа # журнала перевозок с листа Клиенты переносится название клиента, а следующая ячейка активной строки заполняется значением текущей даты. Сам же символ # заносится в соответствующую ячейку следующей строки журнала перевозок.
По символу $ заполняются данными листа Маршруты ячейки Маршрут, Количество, Цена и Сумма журнала перевозок. Далее на следующей строке появляется символ $, а строкой ниже в столбце Сумма появляется формула расчета промежуточных итогов этого столбца, например =ПРОМЕЖУТОЧНЫЕ.ИТОГИ(9;F4:F10). При отсутствии фильтрации данных промежуточные итоги показывают сумму всех значений рассматриваемого столбца.
Аналогичным образом используется и символ &.
Символ @ позволяет макросу Расчет найти последнюю запись журнала понедельных выплат. Далее, двигаясь вверх, макрос находит первую запись, отвечающую текущей неделе. Это позволяет очистить в журнале оплат текущую неделю и внести с нужной позиции свежие данные, после которых проставляются символ @ и итоговые выплаты за текущую неделю.
Кроме указанных символов, приложение должно иметь лист wrk.
Рабочие листы приложения должны быть надлежащим образом отформатированы. Так, столбцы с символьными данными должны иметь текстовый формат, с числовыми – числовой. Столбец с датой (см. журнал перевозок) имеет формат Дата, например, по образцу 14 мар.
' Проверяет наличие в столбцах 1, 3 и 6 строки r символов #, $ и &
' Возвращает true, если символы имеются, или false - в противном случае
' Используется только на листе Перевозки
Function checkSmbls(r)
checkSmbls = Not (Cells(r, 1).Value = "#" Or Cells(r, 3).Value = "$" Or Cells(r, 6).Value = "&")
End Function
'
' Находит на листе sh символ smbl и возвращает номер строки с найденным символом + shft
Function fndSmbl(sh, smbl, shft)
Sheets(sh).Activate
Range("A1").Activate
Set c = Cells.Find(What:=smbl)
If c Is Nothing Then
MsgBox ("Не найден символ " + smbl)
fndSmbl = -1
Else
c.Activate
fndSmbl = c.Row + shft
End If
End Function
' Копирует часть столбца clm листа sh в указанную часть столбца clm2 листа sh2
Sub onePaste(sh, sh2, clm, nOS, nLLS, clm2, nBG, nLL)
nE = nBG + nLL - 1
Sheets(sh).Range(clm + nOS + ":" + clm + nLLS).Copy
Sheets(sh2).Activate
Range(clm2 + LTrim(Str(nBG)) + ":" + clm2 + LTrim(Str(nE))).Activate
ActiveSheet.Paste
End Sub
'
' Копирует, сохраняя формат ячеек, часть столбца clm листа sh в указанную часть столбца clm2 листа sh2
Sub onePasteS(sh, sh2, clm, nOS, nLLS, clm2, nBGS)
Sheets(sh).Activate
Range(clm + nOS + ":" + clm + nLLS).Copy
Sheets(sh2).Activate
Range(clm2 + nBGS).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End Sub
Очистка журнала перевозок выполняется следующей процедурой:
Sub очистить()
If MsgBox("Таблица будет очищена. Продолжить?", vbOKCancel) = vbCancel Then
Exit Sub
End If
' Находим на листе Перевозки по символу # номер предпоследней заполненной строки
nSmbl = fndSmbl("Перевозки", "#", 0)
If nSmbl = -1 Then
Exit Sub
End If
' Очищаем начиная с 4-й строки все использованные ячейки столбцов A - H
Range("A4:H" + LTrim(Str(nSmbl + 1))).ClearContents
' Вводим символы Клиента, Маршрута и Водителя
Range("A4").Value = "#"
Range("C4").Value = "$"
Range("G4").Value = "&"
End Sub
Макросы, связанные с одноименными кнопками листа Перевозки, тривиальны:
Sub клиент()
Sheets("Клиенты").Activate
End Sub
'
Sub маршрут()
Sheets("Маршруты").Activate
End Sub
'
Sub водитель()
Sheets("Водители").Activate
End Sub
Копирование даты с единичным инкрементом обеспечивает следующий макрос:
' Устанавливает после проверок в текущую ячейку увеличенное на единицу значение вышележащей ячейки
' Работает только в столбце с датой
Sub датаПлюс()
With ActiveCell
vl = .Offset(-1, 0).Value
If .Row > 4 And .Column = 2 And Not IsEmpty(vl) And checkSmbls(.Row) Then
.Value = vl + 1
Else
MsgBox ("Invalid")
End If
End With
End Sub
Копирует после проверок в текущую ячейку значение вышележащей ячейки.
Sub копироватьЗначение()
With ActiveCell
vl = .Offset(-1, 0).Value
If .Row > 4 And Not IsEmpty(vl) And checkSmbls(.Row) Then
.Value = vl
Else
MsgBox ("Invalid")
End If
End With
End Sub
Запись журнала перевозок формируется процедурами выборКлиента, выборМаршрута и выборВодителя. Кроме того, процедуры выборМаршрута и выборВодителя формируют промежуточные итоги соответственно по суммарной стоимости перевозок и суммарным начислениям водителям.
' Переносит с листа Клиенты в журнал перевозок сведения о выбранном клиенте
Sub выборКлиента()
r = ActiveCell.Row
vl = Cells(r, 1).Value
If r >2 And Not IsEmpty(vl) Then
' После проверок ищем на листе Перевозки символ #
nSmbl = fndSmbl("Перевозки", "#", 0)
If nSmbl = -1 Then
Exit Sub
End If
' Работаем на листе Перевозки
' Заполняем на месте символа "#" ячейку Клиент
ActiveCell.Value = vl
' Устанавливаем в ячейку Дата текущую дату
ActiveCell.Offset(0, 1).Value = Date
' Вводим символ Клиента
ActiveCell.Offset(1, 0).Value = "#"
rS = LTrim(Str(nSmbl + 1))
' Очистка строки с промежуточными итогами
Range("B" + rS + ":H" + rS).ClearContents
' Переходим на лист Маршруты
Sheets("Маршруты").Activate
Else
MsgBox ("Invalid")
End If
End Sub
'
' Переносит с листа Маршруты в журнал перевозок сведения о выбранном маршруте
Sub выборМаршрута()
r = ActiveCell.Row
vl = Cells(r, 1).Value
vl2 = Cells(r, 2).Value
If r >2 And Not IsEmpty(vl) Then
' После проверок ищем на листе Перевозки символ $
nSmbl = fndSmbl("Перевозки", "$", 0)
If nSmbl = -1 Then
Exit Sub
End If
' Работаем на листе Перевозки
' Заполняем ячейки Маршрут, Количество, Цена и Сумма
ActiveCell.Value = vl
ActiveCell.Offset(0, 1).Value = 1
ActiveCell.Offset(0, 2).Value = vl2
rS = LTrim(Str(nSmbl))
' Формула расчета суммы (Количество * Цена)
ActiveCell.Offset(0, 3).Formula = "=D" + rS + "*E" + rS
' Вводим символ Маршрута
ActiveCell.Offset(1, 0).Value = "$"
' Промежуточные итоги по столбцу Сумма
ActiveCell.Offset(2, 2).Value = "Итого:"
ActiveCell.Offset(2, 3).Formula = "=SUBTOTAL(9,F4:F" + rS + ")"
' Переходим на лист Водители
Sheets("Водители").Activate
Else
MsgBox ("Invalid")
End If
End Sub
'
' Переносит с листа Водители в журнал перевозок сведения о выбранном водителе
Sub выборВодителя()
r = ActiveCell.Row
vl = Cells(r, 1).Value
vl2S = LTrim(Str(Cells(r, 2).Value))
If r >2 And Not IsEmpty(vl) Then
' После проверок ищем на листе Перевозки символ &
nSmbl = fndSmbl("Перевозки", "&", 0)
If nSmbl = -1 Then
Exit Sub
End If
' Работаем на листе Перевозки
' Заполняем ячейки Водитель и Оплата
ActiveCell.Value = vl
rS = LTrim(Str(nSmbl))
' Формула расчета оплаты (Коэффициент * Сумма)
ActiveCell.Offset(0, 1).Formula = "=" + vl2S + "*F" + rS
' Вводим символ Водителя
ActiveCell.Offset(1, 0).Value = "&"
' Промежуточные итоги по столбцу Оплата
ActiveCell.Offset(2, 1).Formula = "=SUBTOTAL(9,H4:H" + rS + ")"
Else
MsgBox ("Invalid")
End If
End Sub
Расчет начислений водителям осуществляется нижеприводимой процедурой после нажатия на кнопку Расчет листа Оплата.
Sub расчет()
' Номер текущей недели
w = Sheets("Неделя").Cells(1, 2).Value
' Номер последней строки-перевозки на листе Перевозки
nLL = fndSmbl("Перевозки", "#", -1)
If nLL = -1 Then
Exit Sub
End If
' Номер первой строки-перевозки на листе Перевозки
nOS = "4"
nLLS = LTrim(Str(nLL))
' Число перевозок
nLL2 = nLL - 3
' Очищаем с запасом вспомогательный лист wrk
Sheets("wrk").Range("A1:G1000").ClearContents
' Копируем с листа Перевозки на лист wrk столбцы Водитель и Оплата
Call onePaste("Перевозки", "wrk", "G", nOS, nLLS, "A", 1, nLL2)
Call onePasteS("Перевозки", "wrk", "H", nOS, nLLS, "B", "1")
' Сортируем по возрастанию на листе wrk список водителей (рис. 5)
Columns("A:B").SortSpecial
' Формируем на листе wrk в столбцах E - G ведомость начислений
' с итогами по каждому водителю и общими недельными начислениями
d = Range("A1").Value
t = Range("B1").Value
' s - начислено водителю d
s = t
' sLL - начислено всем водителям за текущую неделю
sLL = t
r2 = 1
For r = 2 To nLL2
rS = LTrim(Str(r))
d2 = Range("A" + rS).Value
t = Range("B" + rS).Value
If d2 <> d Then
rs2 = LTrim(Str(r2))
Range("E" + rs2).Value = w
Range("F" + rs2).Value = d
Range("G" + rs2).Value = s
' Меняем текущего водителя
d = d2
s = t
r2 = r2 + 1
Else
s = s + t
End If
sLL = sLL + t
Next
rs2 = LTrim(Str(r2))
Range("E" + rs2).Value = w
Range("F" + rs2).Value = d
Range("G" + rs2).Value = s
rs2 = LTrim(Str(r2 + 1))
Range("F" + rs2).Value = "Итого за текущую неделю:"
Range("G" + rs2).Value = sLL
' Ищем на листе Оплата символ @
nWL = fndSmbl("Оплата", "@", 0)
If nWL = -1 Then
Exit Sub
End If
nWL0 = nWL - 1
nWLS0 = LTrim(Str(nWL0))
' Поиск на листе Оплата первой строки, отвечающей текущей неделе w
kM = 1000
k = 0
While Range("A" + nWLS0).Value = w And k <kM
k = k + 1
nWL0 = nWL0 - 1
nWLS0 = LTrim(Str(nWL0))
Wend
nWL0 = nWL0 + 1
nWLS0 = LTrim(Str(nWL0))
nWL2 = nWL0 + nLL2
nWLS2 = LTrim(Str(nWL2))
' Очищаем ячейки, отвечающие текущей неделе
Range("A" + nWLS0, "C" + nWLS2).ClearContents
' Переносим с листа wrk на лист Оплата ведомость начислений и итоговую строку
Sheets("wrk").Range("E1:G" + rs2).Copy
Range("A" + nWLS0).Select
ActiveSheet.Paste
nWL0 = nWL0 + r2
nWLS = LTrim(Str(nWL0))
Range("A" + nWLS).Value = "@"
End Sub
Приведенный механизм учета хозяйственных операций легко реализуем, прост в употреблении и легко адаптируется к текущим нуждам предприятия. Но он не может быть рекомендован для формирования регламентированной отчетности о деятельности организации. Для этих целей можно взять, например, 1С:Предприятие или иную программу, обладающую свежими версиями необходимых печатных форм.