VBA每月獲得員工成本

Question

我有一個表格，其中包含有關員工何時開始和結束的信息，並且我想了解每個月隨着時間的推移花費多少的報表。

這裏的表（我在這裏簡化位爲清楚起見）

例子：

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，如果它的事項

Answer 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