VBA每月获得员工成本

时间:2014-03-29 16:26:01

标签: ms-access access-vba

我有一张表格,其中包含员工何时开始和结束的信息,我希望得到一份报告,说明每个月的花费是多少。

这是表格(为了清晰起见,我在这里简化了一点)

示例:

EmployeeID, Name, Position, StartDate, EndDate, MonthlySalary
1, John Doe, Intern, 2/1/2010, 1/1/2013, $1,000
2, Jane Doe, CEO, 1/1/2010, , $10,000
3, Bob Doe, CFO, 2/1/2010, 2/1/2013, $8,000
...

我想得到的输出是一个如下所示的表:

ExpenseDate, Amount, EmployeeCount
1/1/2010, $10,000, 1
2/1/2010, $11,000, 2
3/1/2010, $11,000, 2
4/1/2010, $19,000, 3
...
1/1/2013, $18,000, 2   -- intern left
2/1/2013, $10,000, 1   -- CFO left
...
3/1/2014, $10,000, 1   -- no end date for CEO

如果信息采用以下格式,我可以很容易地将其转换为上面所需的内容:

EmployeeID, ExpenseDate, Amount
1, 2/1/2010,  $1,000
1, 3/1/2010,  $1,000
1, 4/1/2010,  $1,000
...
2, 2/1/2010,  $10,000
2, 3/1/2010,  $10,000
2, 4/1/2010,  $10,000
...

是否可以使用某些VBA代码创建其中一个表?

如果重要,我会使用Access 2010

1 个答案:

答案 0 :(得分:1)

以下代码将使用您现有的数据为每个雇员构建一个付款表,用于每个月。您需要解决部分月工资的问题(除以30?)

Option Compare Database
Option Explicit


Function Build_Emo_Pay_Table()
Dim strSQL      As String
Dim dbs         As DAO.Database
Dim rsIN        As DAO.Recordset
Dim rsOT        As DAO.Recordset
Dim iMonths     As Integer
Dim iLoop       As Integer
Dim datLast     As Date

    Set dbs = CurrentDb
    On Error Resume Next

    ' !! NOTE !!  Decide how to 'maintain' pay table. Choices are rebuild each time,
    '             or add new months, or adjust previous 'partial month'
    ' This code deletes table 'tblEmpPay' each time and rebuilds.
    Debug.Print dbs.TableDefs("tblEmpPay").Name         ' To raise error
    If Err.Number = 0 Then
        Debug.Print Err.Number & vbTab & Err.Description
        dbs.TableDefs.Delete ("tblEmpPay")
    End If
    On Error GoTo 0
    strSQL = "CREATE TABLE tblEmpPay (PayEmpID INT, PayDate Date, PayEmpPaid long);"
    dbs.Execute strSQL

    strSQL = "CREATE UNIQUE INDEX PayKey ON tblEmpPay (PayEmpID, PayDate) WITH DISALLOW NULL;"
    dbs.Execute strSQL

    strSQL = "select * from tblEmployee Order by EmpID;"
    Set rsIN = dbs.OpenRecordset(strSQL)
    Set rsOT = dbs.OpenRecordset("tblEmpPay", adOpenDynamic)

    ' Process each employee record
    Do While Not rsIN.EOF
        If IsDate(rsIN!empLeave) Then
            datLast = rsIN!empLeave
        Else
            datLast = Date
        End If

        iMonths = DateDiff("m", rsIN!empStart, datLast)         ' Get Months employeed (note will not get partial month!)

        Debug.Print rsIN!empName & vbTab & rsIN!empStart & vbTab & rsIN!empLeave & vbTab & DateDiff("m", rsIN!empStart, rsIN!empLeave)
        '!! NOTE !! Depending on how you want to handle partial months, change next line. i.e. If employee leaves
        '           on first day of month, or during the month, what is your formula for how much do they get paid?
        For iLoop = 0 To iMonths - 1
            rsOT.AddNew
            rsOT!PayEmpID = rsIN!empId
            rsOT!PayDate = DateAdd("m", iLoop, rsIN!empStart)
            rsOT!PayEmpPaid = rsIN!empsalary
            rsOT.Update
        Next iLoop
        rsIN.MoveNext
    Loop
    rsIN.Close
    Set rsIN = Nothing
    Set dbs = Nothing
End Function
相关问题