Unpivot an Excel matrix/pivot-table?

前端 未结 4 1012
慢半拍i
慢半拍i 2020-12-07 04:28

Is there a quick way to \"unpivot\" an Excel matrix/pivot-table (in Excel or elsewhere), without writing macros or other code ?
Again, I can write co

4条回答
  •  攒了一身酷
    2020-12-07 05:03

    I am using this VBA code

    Sub Unpivot()
    '
    Dim Rowlabel As Range
    Dim Columnlabel As Range
    Dim Pap As Range
    Dim Tabl As Range
    Dim i As Integer
    Dim j As Integer
    Dim a As Integer
    Dim b As Integer
    Dim Data As Range
    Dim k As Integer
    Dim Label As Range
    Dim pvtCache As PivotCache
    Dim pvt As PivotTable
    Dim SrcData As String
    '
    ActiveSheet.Copy Before:=Worksheets(1)
    Set Tabl = Selection
        For Each Pap In Tabl
         If Pap.MergeCells Then
            With Pap.MergeArea
                .UnMerge
                .Value = Pap.Value
            End With
        End If
        Next
    i = Application.InputBox("Number of row contain label:", "Excel", i, Type:=2)
    j = Application.InputBox("Number of column contain label:", "Excel", j, Type:=2)
    On Error Resume Next
    Sheets("Unpivot_Table").Delete
    Sheets.Add.Name = "Unpivot_Table"
    Set Pap = Range("Unpivot_Table!B2")
    b = Tabl.Rows.Count
    a = Tabl.Columns.Count
    Set Data = Range(Tabl.Cells(i + 1, j + 1), Tabl.Cells(b, a))
    Set Columnlabel = Range(Tabl.Cells(i + 1, 1), Tabl.Cells(b, j))
    Set Rowlabel = Range(Tabl.Cells(1, j + 1), Tabl.Cells(i, a))
    Pap.Select
    For Each Column In Data.Columns
        Column.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        Columnlabel.Copy
        Selection.Offset(0, 1).PasteSpecial Paste:=xlPasteValues
        Column.Copy
        Selection.Offset(b - i, -1).Select
    Next Column
    Pap.Offset(0, j + 1).Select
    For Each Column In Rowlabel.Columns
        Column.Copy
        Range(Selection, Selection.Offset(b - i - 1, 0)).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        Selection.End(xlDown).Offset(1, 0).Select
    Next Column
    Set Label = Range(Pap.Offset(-1, 0), Pap.Offset(0, i + j + 1))
        For k = 1 To i + j + 1
        Label.Cells(1, k).Value = Application.InputBox(Label.Cells(2, k).Value & " is belong to Fieldname", "Hoang", k, Type:=2)
        Next
    Range(Pap.End(xlUp), Pap.End(xlDown).End(xlToRight)).Select
    SrcData = ActiveSheet.Name & "!" & Selection.Address
    On Error Resume Next
        Sheets("Pivot").Delete
        Sheets.Add.Name = "Pivot"
      Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
        SourceType:=xlDatabase, _
        SourceData:=SrcData)
      Set pvt = pvtCache.CreatePivotTable( _
        TableDestination:="Pivot!" & Sheets("Pivot").Range("A3").Address(ReferenceStyle:=xlR1C1), _
        TableName:="PivotTable1")
    End Sub
    

提交回复
热议问题