转换excel电子表格，其中包含日期标题和列，以及时间表的名称、输入和输出时间

我有一个时间表，标题是员工姓名、入/出时间和日期范围

这看起来像是复制到了更大的卷中

但是，将其“转置”到的所需格式是：

---

我们还收到大量此类电子表格，因此不需要手动换位。

如果看起来是这样，手动执行此操作的最简单方法是选择整个表格，复制。然后右键单击其他区域并选择“粘贴特殊…”。。。。选中“转置”复选框并单击“确定”

---

如果要自动执行此操作，可以录制执行这些步骤的宏。注意选择数据的方式，这样当您再次运行宏时，它将选择所有数据，而不是与录制宏时尺寸相同的矩形。

t一般思路是循环源数据，识别名称、日期和时间。然后在所需布局中构建一个新表

使用变体阵列执行此操作将使其速度非常快

像这样的

Sub TransposeTime(wsSrc As Worksheet, Optional wsDst As Worksheet)
    Dim rSrc As Range, rDst As Range
    Dim Src As Variant, Dst As Variant
    Dim EmployeeCount As Long
    Dim DateCount As Long
    Dim SrcRow As Long, DstRow As Long, DateRow As Long

    On Error GoTo EH

    If wsSrc Is Nothing Then Exit Sub

    ' Get reference to source data.  Use Column B to get number of rows
    With wsSrc
        Set rSrc = .Range(.Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 1), .Cells(1, .Columns.Count).End(xlToLeft))
    End With

    ' Put source data in a Variant Array
    Src = rSrc.Value2

    ' Count Employees and Dates
    EmployeeCount = Application.CountA(rSrc.Columns(1)) - 1
    DateCount = Application.CountA(rSrc.Rows(1)) - 2

    ' if wsDst is missing, overwrite source
    If wsDst Is Nothing Then
        Set wsDst = wsSrc
        wsSrc.UsedRange.Clear
    End If

    ' Size destination array
    ReDim Dst(0 To EmployeeCount * DateCount, 1 To 4)

    ' Headers
    Dst(0, 1) = "Employee Name"
    Dst(0, 2) = "Date"
    Dst(0, 3) = "Time In"
    Dst(0, 4) = "Time Out"

    ' Loop source data, process each Time In row
    DstRow = 0
    For SrcRow = 1 To UBound(Src, 1)
        If StrComp(Src(SrcRow, 2), "Time In", vbTextCompare) = 0 Then
            ' Loop dates for each employee
            For DateRow = 1 To DateCount
                Dst(DateRow + DstRow, 1) = Src(SrcRow, 1) 'Name
                Dst(DateRow + DstRow, 2) = Src(1, DateRow + 2) 'Date
                If Not IsEmpty(Src(SrcRow, DateRow + 2)) Then
                    Dst(DateRow + DstRow, 3) = Src(SrcRow, DateRow + 2) ' In
                    Dst(DateRow + DstRow + 1, 4) = Src(SrcRow + 1, DateRow + 2) ' Out
                End If
            Next
            DstRow = DstRow + DateCount
        End If
    Next

    ' Place result on sheet
    Set rDst = wsDst.Cells(1, 1).Resize(UBound(Dst, 1) + 1, UBound(Dst, 2))
    rDst.Value = Dst

    ' Format Date and Time Columns
    rDst.Columns(2).NumberFormat = "mm/dd/yyyy"
    rDst.Columns(3).Resize(, 2).NumberFormat = "h:mm:ss AM/PM"

Exit Sub
EH:
    ' on error restore source data
    If Not IsEmpty(Src) Then
        wsSrc.Cells(1, 1).Resize(UBound(Src, 1), UBound(Src, 2)).Value = Src
    End If
    MsgBox "Oops..."
End Sub

由于有许多工作表需要处理，因此需要另一个

Sub

来处理这些工作表，并将其称为

Sub

调用一张图纸的演示

Sub Demo()
    TransposeTime ActiveSheet
End Sub

---

大家好，我很抱歉。这是第一次过帐到堆栈溢出。我编辑了第一幅图像。为了帮助我们，请将示例数据添加为文本，以便我们可以复制/粘贴它。