自动写入另一张表格

时间:2014-05-08 13:41:09

标签: arrays excel-formula excel-2013

我目前正在使用此模板记录员工假期请求 http://office.microsoft.com/en-gb/templates/employee-absence-schedule-TC103987167.aspx

我添加了数组公式,以给出每个月员工享有假期/无薪假期/生病/延迟等的特定天数 例如

=SUM(LEN(B5:AF5)-LEN(SUBSTITUTE(B5:AF5,"H","")))/LEN("H")

并将这些总数合并以获得一年的概述,但我仍然需要查看工作表以获取他们请求的完整日期列表并复制数据。

是否有我可以输入的公式,因此我可以为每位员工制作一张表格,当H出现在表格1月B8-AF8上写下月份名称和相应的第4行日期和日期。

我正在努力实现这样的自动功能?

我目前无法发布图片,但如果您需要我详细说明,请告诉我。

1 个答案:

答案 0 :(得分:0)

如果我理解正确,您需要每位员工1张?据我所知,没有使用某些代码(VBA或其他)自动添加工作表的方法。如果您已经创建了工作表,那么我确信我们可以提出一个公式。

无论如何,这里有一些你可以尝试的VBA代码......它创建了一个新的工作簿来汇总数据。没有任何错误检查,它假设你是从你提供的模板运行它。只需添加一个调用EmployeeSummary的按钮即可。

Type DayOffType
    Month As String
    DayOfWeek As String
    Date As String
    Type As String
End Type

Type EmployeeType
    Name As String
    DaysOff() As DayOffType
    NumberOfDaysOff As Long
End Type

Private EmployeeData() As EmployeeType
Private EmployeeCount As Long

Sub EmployeeSummary()
Dim wb As Excel.Workbook
    Call ReadSchedule(ThisWorkbook)
    Set wb = Workbooks.Add
    Call WriteSummary(wb, "H")
End Sub

Sub ReadSchedule(Book As Excel.Workbook)
Dim tbl As Excel.Range
Dim TableName As String
Dim sMonth As String, sDay As String
Dim iMonth As Integer, iDate As Integer
Dim iEmployee As Long, iRow As Long, iCol As Long

    For iMonth = 1 To 12
        sMonth = MonthName(iMonth)
        With Book.Worksheets(sMonth)
            TableName = "tbl" & sMonth
            Set tbl = .ListObjects(TableName).Range
            For iRow = 2 To tbl.Rows.Count - 1
                iEmployee = GetEmployee(tbl.Cells(iRow, 1))
                For iCol = 2 To tbl.Columns.Count - 1
                    If tbl.Cells(iRow, iCol) <> vbNullString Then
                        AddDayOff iEmployee, sMonth, tbl, iRow, iCol
                    End If
                Next
            Next
        End With
    Next
End Sub

Private Function GetEmployee(Name As String)
Dim i As Long
    For i = 0 To EmployeeCount - 1
        If EmployeeData(i).Name = Name Then Exit For
    Next
    If i >= EmployeeCount Then
        ReDim Preserve EmployeeData(EmployeeCount)
        EmployeeData(EmployeeCount).Name = Name
        EmployeeCount = EmployeeCount + 1
    End If
    GetEmployee = i
End Function

Private Sub AddDayOff(Employee As Long, Month As String, Table As Range, Row As Long, Col As Long)
    With EmployeeData(Employee)
        ReDim Preserve .DaysOff(.NumberOfDaysOff)
        With .DaysOff(.NumberOfDaysOff)
            .Date = Table.Cells(1, Col)
            .DayOfWeek = Table.Cells(0, Col)
            .Month = Month
            .Type = Table.Cells(Row, Col)
        End With
        .NumberOfDaysOff = .NumberOfDaysOff + 1
    End With
End Sub

Private Sub WriteSummary(Book As Excel.Workbook, Optional AbsenceType As String = "H")
Dim ws As Excel.Worksheet
Dim cell As Excel.Range
Dim i As Long, d As Long
    Set ws = Book.Worksheets(1)
    For i = 0 To EmployeeCount - 1
        With ws
            .Name = EmployeeData(i).Name
            .Range("A1") = EmployeeData(i).Name
            Set cell = .Range("A2")
            For d = 0 To EmployeeData(i).NumberOfDaysOff - 1
                If EmployeeData(i).DaysOff(d).Type = AbsenceType Then
                    cell = EmployeeData(i).DaysOff(d).Month
                    cell.Offset(0, 1) = EmployeeData(i).DaysOff(d).DayOfWeek
                    cell.Offset(0, 2) = EmployeeData(i).DaysOff(d).Date
                    Set cell = cell.Offset(1, 0)
                End If
            Next
        End With
        Set ws = Book.Worksheets.Add(after:=Book.Worksheets(Book.Worksheets.Count))
    Next
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True
End Sub