[[20090824192500]]　『マクロの省略』（フムフム）　ページの最後に飛ぶ

『マクロの省略』（フムフム）

　下記は、マクロの記録等でピボットテーブルを処理したものですが、
　えらく冗長なマクロなので短くまとめることは可能でしょうか？
　特に、.Subtotals = Array(False, False, False, False, False,
　False, False, False, False, False, False, False)が、
　みづらいのですが・・・

 Sub 注残一覧まとめ()

    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "手配残数抽出!R2C1:R5000C13").CreatePivotTable 
 TableDestination:=Sheets("注残一覧まとめ").Range("B2"), _
        TableName:="ピボットテーブル4"
  Sheets("注残一覧まとめ").Select

    With ActiveSheet.PivotTables("ピボットテーブル4").PivotFields("I_指示先番号")
        .Orientation = xlRowField
    End With
    With ActiveSheet.PivotTables("ピボットテーブル4").PivotFields("I_品目番号")
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, 
False, False, False, False, False)
    End With
    With ActiveSheet.PivotTables("ピボットテーブル4").PivotFields("I_手配日")
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, 
False, False, False, False, False)
    End With
    With ActiveSheet.PivotTables("ピボットテーブル4").PivotFields("I_手配数")
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, 
False, False, False, False, False)
    End With
    With ActiveSheet.PivotTables("ピボットテーブル4").PivotFields("I_受入数")
        .Orientation = xlDataField
        ActiveSheet.PivotTables("ピボットテーブル4").PivotFields("データの個数 : I_受入数").Function = xlSum
    End With
    With ActiveSheet.PivotTables("ピボットテーブル4").PivotFields("I_手配番号")
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, 
False, False, False, False, False)
    End With

    Application.CommandBars("PivotTable").Visible = False
    Range("C1").Value = Date & " NETIS更新作成"
    With Range("C1").Font
        .Bold = True
        .Size = 14
        .ColorIndex = 3
    End With
        ActiveWindow.SplitRow = 3
    ActiveWindow.FreezePanes = True
 End Sub

 マクロは、環境を整えないと動かせません。
 しかし、コードから環境を想像して整えるのは大変です。

 どの様なデータがあるのか。
 どの様なピボットテーブルを作成したのか。
 どの様な結果になればよいのか。

 書いて於いた方が、良いと思いますよ。

 想像で書くと
 　.Subtotals = Array(False, False,・・・
 の部分は
 　.Subtotals(1) = False
 に出来るんじゃないかと思います。

 後は
 　「ActiveSheet.PivotTables("ピボットテーブル4")」
 が何度も出てきているので、Wiht でまとめて仕舞うと
 少しはすっきりするかもしれません。

 上手く行くかどうかは分かりませんけどね。

 (HANA)

 こんにちは。かみちゃん　です。

 HANAさんからコメントがついていますが、検討していましたので、アップさせていただきます。

 > マクロの記録等でピボットテーブルを処理したものですが、　えらく冗長なマクロなので短くまとめることは可能でしょうか

 以下のような感じではいかがでしょうか？
 あまり短くはなっていませんが、多少は、すっきりさせたつもりです。

 Sub 注残一覧まとめ2()
     Dim WS1 As Worksheet

     Set WS1 = Sheets("注残一覧まとめ")

     With ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
         "手配残数抽出!R2C1:R5000C13").CreatePivotTable(TableDestination:=WS1.Range("B2"))

         With .PivotFields("I_指示先番号")
             .Orientation = xlRowField
             .Subtotals(1) = False
         End With
         With .PivotFields("I_品目番号")
             .Orientation = xlRowField
             .Subtotals(1) = False
         End With
         With .PivotFields("I_手配日")
             .Orientation = xlRowField
             .Subtotals(1) = False
         End With
         With .PivotFields("I_手配数")
             .Orientation = xlRowField
             .Subtotals(1) = False
         End With
         With .PivotFields("I_手配番号")
             .Orientation = xlRowField
             .Subtotals(1) = False
         End With
         .PivotFields("I_受入数").Orientation = xlDataField
         With .PivotFields("データの個数 : I_受入数")
 '        With .PivotFields("データの個数 / I_受入数")
           .Function = xlSum
         End With

         With WS1.Range("C1")
             .Value = Date & " NETIS更新作成"
             With .Font
                 .Bold = True
                 .Size = 14
                 .ColorIndex = 3
             End With
         End With

     End With
     ActiveWindow.SplitRow = 3
     ActiveWindow.FreezePanes = True
 End Sub

 なお、上記は、環境を作って動作確認していますが、うまく動作しない場合は、
 HANAさんもおっしゃっているとおり

 > どの様なデータがあるのか。

 を説明していただきたいと思います。

 To,HANAさん

 > 想像で書くと
 > 　.Subtotals = Array(False, False,・・・
 > の部分は
 > 　.Subtotals(1) = False
 > に出来るんじゃないかと思います。

 このような書き方ができるのですね。
 非常に勉強になりましたので、勝手ながら、使わせていただきました。
 ありがとうございます。

 (かみちゃん)
 2009/08/24 22:22 22:27 追加/修正

 こんにちは。
 以下のような処理では如何でしょうか？
 前段に"注残一覧まとめ"シートのデータを削除する処理を加えています。

 ピボットテーブルを名前で指定して処理しないのであれば
 , TableName:="ピボットテーブル4" 　を省略することもできます。

Sub 注残一覧まとめ改造()

    Dim PvtFldName As Variant

    With Worksheets("注残一覧まとめ")

        .Cells.Clear
        .Cells.ColumnWidth = .StandardWidth
        Windows(.Index).SplitRow = 0
        Windows(.Index).FreezePanes = False

        With ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
            SourceData:="手配残数抽出!R2C1:R5000C13").CreatePivotTable( _
                TableDestination:=.Range("B2"), TableName:="ピボットテーブル4")

            Application.CommandBars("PivotTable").Visible = False

            For Each PvtFldName In Array("I_品目番号", "I_手配日", "I_手配数", "I_手配番号")
                .PivotFields(PvtFldName).Subtotals(1) = False
            Next PvtFldName

            .AddFields RowFields:=Array("I_指示先番号", "I_品目番号", "I_手配日", "I_手配数", "I_手配番号")
            With .PivotFields("I_受入数")
                .Orientation = xlDataField
                .Caption = "データの個数 : I_受入数"
                .Function = xlSum
            End With

        End With

        With .Range("C1")
            With .Font
                .Bold = True
                .Size = 14
                .ColorIndex = 3
            End With
            .Value = Date & " NETIS更新作成"
        End With
        Windows(.Index).SplitRow = 3
        Windows(.Index).FreezePanes = True
        .Activate

    End With

End Sub

(OtenkiAme)

 > 　.Subtotals(1) = False
 で、だいぶみやすくなりました。
　無事に動きました。

 (HANA)、(かみちゃん)、(OtenkiAme) さんいろいろありがとうございます。
これからも勉強しますのでなにかあったらお願いします。

　　　　　　　　　　　　　（フムフム）

コメント返信：

[ 一覧(最新更新順) ]

[[20090824192500]] 『マクロの省略』（フムフム） ページの最後に飛ぶ

[[20090824192500]]　『マクロの省略』（フムフム）　ページの最後に飛ぶ