时间戳

首页 > 解决方案 > 循环转置excel中的数据

excel - 循环转置excel中的数据

问题描述

我正在尝试使用 VBA 对报告中的数据进行转置/重新格式化，以将员工姓名复制到新工作表，然后将错过的打卡次数、迟到、迟到等复制到带有这些标题的列中。诀窍是可变行取决于员工没有考勤卡问题，或者是否有几种不同的考勤卡问题。

此报告的长度可能会有所不同，但 A 列中有一个“总计”可能会触发循环停止。每个 Employee 块之间有一个空白单元格，可以触发一个直到循环移动到 H 列并找到列出的每个问题的计数。

输入：

在此处输入图像描述

期望的输出：

在此处输入图像描述

感谢任何帮助！

我曾尝试使用 PasteSpecial Transpose 进行试验，但我的问题是让一个循环从单元格 B43 开始，并让它拉出名称，粘贴到新工作表中，然后将任何时间卡问题复制并粘贴到下一页的列中。

标签： excelvbaloopstranspose

解决方案

这是草稿，可以对真实数据进行一些额外的测试。枢轴列需要是标准宽度，并且需要包装它们的列标题。它总结了重复的名称（例如 Trumpy、Trump）。

Option Explicit
Option Base 1

Sub do_TransposeData()

    Const colNewName As Integer = 1
    Const colNameAndExcept As Integer = 2
    Const col4Transpose As Integer = 7
    Const colTally As Integer = 8

    Dim Sheet As Excel.Worksheet, thisSheet As String
    Set Sheet = ThisWorkbook.ActiveSheet
    thisSheet = ThisWorkbook.ActiveSheet.Name

    Const wsNewJustEE As String = "NewJustEE"
    Const wsNewPivot As String = "NewPivot"
    Dim ws As Excel.Worksheet
    For Each ws In Worksheets
        If ws.Name = wsNewJustEE Or ws.Name = wsNewPivot Then
            Application.DisplayAlerts = False
            Sheets(ws.Name).Delete
            Application.DisplayAlerts = True
        End If
    Next
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = wsNewJustEE
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = wsNewPivot

    Sheets(wsNewJustEE).Select
    Dim colHeads  As Variant, newRow As Long, newCol As Long
    colHeads = Array("Employee", "NameOrExcept", "cc", "dd", "ee", "ff", "ExTranspose", "ExCount")  '  <<<<<<<<<<<<<<<<<<<<
    newRow = 1
    For newCol = 1 To 8
        Sheets(wsNewJustEE).Cells(newRow, newCol) = colHeads(newCol)
    Next newCol





    Dim sPriorRowName As String, sThisRowName As String, sSavedName As String
    Dim flagInNames As Boolean, flagInExceptions As Boolean

    Dim nRow As Long, maxRow As Long
    maxRow = Sheet.Cells(Sheet.Rows.Count, "B").End(xlUp).Row


    For nRow = 1 To maxRow

        sPriorRowName = sThisRowName
        sThisRowName = Sheet.Cells(nRow, colNameAndExcept)

        If (flagInNames) Then
            ' need to test from bottom up
            If (sThisRowName = "TOTALS") Then
                flagInExceptions = False
            End If

            If (flagInExceptions And sThisRowName <> "EXCEPTIONS") Then
                newRow = newRow + 1
                For newCol = 1 To 8
                    Sheets(wsNewJustEE).Cells(newRow, newCol) = Sheets(thisSheet).Cells(nRow, newCol)
                Next newCol
                Sheets(wsNewJustEE).Cells(newRow, colNewName) = sSavedName
                Sheets(wsNewJustEE).Cells(newRow, col4Transpose) = "4Transpose"
            End If

            If (sThisRowName = "EXCEPTIONS" And Not flagInExceptions) Then
                sSavedName = sPriorRowName
                flagInExceptions = True
            End If
        End If

        If (sThisRowName = "NAME") Then
            flagInNames = True
        End If

    Next nRow

    Sheets(wsNewJustEE).Select
    Cells.Select
    Sheets(wsNewPivot).Select
    do_Pivot

End Sub

'    Sheets("NewJustEE").Select
'    Cells.Select
'    Sheets.Add
'    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
'        "NewJustEE!R1C1:R65536C8", Version:=xlPivotTableVersion10).CreatePivotTable _
'        TableDestination:="Sheet4!R3C1", TableName:="PivotTable1", DefaultVersion _
'        :=xlPivotTableVersion10
'    Sheets("Sheet4").Select
'    Cells(3, 1).Select
'    Application.Goto Reference:="Macro1"



Sub do_Pivot()

    'Sheets.Add
    'ThisWorkbook.ActiveSheet.Name = "NewPivot"

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "NewJustEE!R1C1:R65536C8", Version:=xlPivotTableVersion10).CreatePivotTable _
        TableDestination:="NewPivot!R3C1", TableName:="PivotTable3", DefaultVersion _
        :=xlPivotTableVersion10
    Sheets("NewPivot").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("ExTranspose")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("ExTranspose")
        .PivotItems("(blank)").Visible = False
    End With
    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
        "PivotTable3").PivotFields("ExCount"), "Count of ExCount", xlCount
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("ExTranspose")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Count of ExCount")
        .Caption = "Sum of ExCount"
        .Function = xlSum
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("NameOrExcept")  '<<<<<<<<<<<<<<<<<
        .Orientation = xlColumnField
        .Position = 1
    End With
    Rows("4:4").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("B:B").ColumnWidth = 4.86
End Sub

推荐阅读