Расчет зарплаты за выбранный период с помощью VBA Excel. Суммирование ежедневных начислений по каждому сотруднику из общей таблицы.
Условие задачи
При ведении учета сдельной зарплаты в программе Excel, может получиться следующая таблица:
В этой таблице отражено ежедневное начисление зарплаты сотрудникам в зависимости от какого-либо объема выполненных за день работ.
Необходимо создать код VBA Excel для расчета зарплаты по каждому сотруднику за выбранный период, например, за месяц.
Расчет зарплаты
Для выбора периода расчета зарплаты создадим следующую форму:
Вызываться она будет кликом по кнопке «Расчет» на листе с таблицей:
|
1 2 3 |
Private Sub CommandButton1_Click() UserForm1.Show End Sub |
Код VBA Excel для расчета зарплаты по каждому сотруднику из общей таблицы с ежедневными начислениями:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 |
Private Sub CommandButton1_Click() Dim r1 As Long, r2 As Long, c As Integer, myRange As Range, myCell As Range, myCollection As New Collection, myElement As Variant c = 6 'номер столбца с зарплатой 'При ошибке в выборе периода переходим к метке Stopsub On Error GoTo Stopsub 'Первая строка выбранного диапазона, ищем сверху вниз r1 = ActiveSheet.Range("A1").CurrentRegion.Columns(1).Find(CDate(TextBox1.Text), SearchDirection:=xlNext).Row 'Последняя строка выбранного диапазона, ищем снизу вверх r2 = ActiveSheet.Range("A1").CurrentRegion.Columns(1).Find(CDate(TextBox2.Text), SearchDirection:=xlPrevious).Row 'Присваиваем ссылку на выбранный диапазон объектной переменной Set myRange = Range(Cells(r1, 1), Cells(r2, c)) 'Отбираем из второго столбца выбранного диапазона уникальные значения ФИО On Error Resume Next For Each myCell In myRange.Columns(2).Cells myCollection.Add CStr(myCell.Value), CStr(myCell.Value) Next myCell On Error GoTo 0 'Создаем новый лист для отчета Worksheets.Add r1 = 1 With ActiveSheet 'Создаем заголовок отчета .Cells(r1, 1) = "Зарплата с " & CDate(TextBox1.Text) & " по " & CDate(TextBox2.Text) .Cells(r1, 1).EntireColumn.AutoFit 'Заполняем строки отчета For Each myElement In myCollection r1 = r1 + 1 'Вставляем в первую колонку ФИО .Cells(r1, 1) = myElement 'Вставляем во вторую колонку сумму зарплаты по ФИО за выбранный период .Cells(r1, 2) = WorksheetFunction.SumIf(myRange.Columns(2), myElement, myRange.Columns(c)) Next myElement End With Unload Me Exit Sub Stopsub: 'При ошибке в выборе периода выводим сообщение, форму для указания дат не закрываем MsgBox "Ошибка в выборе периода!" End Sub |
Об отборе уникальных значений из списка в VBA Excel с помощью объекта Collection вы можете узнать из этой статьи.
Заполняем форму:
Применение функции «CDate» позволяет использовать для ввода дат дефис.
Результат работы кода VBA Excel для расчета зарплаты:
Полученный список сотрудников в отчете, при желании, можно отсортировать по алфавиту.