[[20180217110956]]　『表の整形について』（みき）　ページの最後に飛ぶ

『表の整形について』（みき）

 大項目　中項目　細項目  数量
 　橋　　　A      1　　　30
          A     2      15
   橋脚　　B     1      5

 と、1000件ほど有ります。

 ここから、表組み替えたいと思ってます。

　　　　　　　
　　　　　　大項目　　　橋　　　橋脚合計
　中項目　　細項目

   A        1       30    　　　　　　30
   A        2       15              15
   B        1                5       5

 大項目は、20件ほどです。

　マクロか関数での実現方法を、教えてください

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

別の質門への回答を修正。
レイアウトがちょっと違いますが許してください。

 Option Explicit

 Sub test()
    Dim wsS As Worksheet
    Dim wsD As Worksheet
    Dim tbl As Range
    Dim r As Range
    Dim pvt As PivotTable
    Dim pvf As PivotField

    Set wsS = Worksheets("sheet1")
    Set wsD = Worksheets("sheet2")

    Application.ScreenUpdating = False

    wsD.UsedRange.ClearContents

    Set tbl = wsS.Range("A1").CurrentRegion
    Set r = tbl.Columns("A").SpecialCells(xlCellTypeBlanks)
    r.FormulaR1C1 = "=r[-1]c"

    Set pvt = wsS.Parent.PivotCaches.Create(xlDatabase, tbl). _
                CreatePivotTable(wsD.Range("A1"))

    With pvt
         .RowAxisLayout xlTabularRow
        .RowGrand = True
        .ColumnGrand = False

        For Each pvf In .PivotFields
            pvf.Subtotals(1) = True
            pvf.Subtotals(1) = False
        Next

        .AddFields Array("中項目", "細項目"), "大項目"
        .AddDataField pvt.PivotFields("数量"), , xlSum

        .TableRange1.Copy
        .TableRange1.PasteSpecial xlPasteValues
    End With

    wsD.Rows(1).ClearContents
    r.ClearContents

    wsD.Activate

 End Sub

（マナ） 2018/02/17(土) 12:16

コメント返信：

[ 一覧(最新更新順) ]

[[20180217110956]] 『表の整形について』（みき） ページの最後に飛ぶ

[[20180217110956]]　『表の整形について』（みき）　ページの最後に飛ぶ