[[20090422141823]]　『マクロでピボットテーブル』（ちるちる）　ページの最後に飛ぶ

『マクロでピボットテーブル』（ちるちる）

 マクロの記録でピボットテーブルを登録しました。

 Sub 集計2()
'
' 集計2 Macro
' マクロ記録日 : 2009/4/22  ユーザー名 :
'

    Columns("L:BD").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A2:J2000").Select
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "給料４月!R2C1:R2000C10").CreatePivotTable TableDestination:= _
        "[日払管理表.xls]給料４月!R3C12", TableName:="ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4", DefaultVersion:= _
        xlPivotTableVersion10
    With ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4").PivotFields("氏名")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4").PivotFields("日")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4").AddDataField ActiveSheet.PivotTables( _
        "ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4").PivotFields("支払"), "データの個数 / 支払", xlCount
    ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4").PivotFields("データの個数 / 支払").Function = _
        xlSum
    Columns("L:AJ").Select
    Range("L2").Activate
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("L:BQ").Select
    Range("L2").Activate
    Selection.Interior.ColorIndex = xlNone
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Style = "Comma [0]"

     Range("L3").Select
    ActiveCell.FormulaR1C1 = "=R[-2]C[-11]"
    Range("L4").Select

    Range("L3").Select
 End Sub

 このシートをコピーして５月、６月とシートを増やして使いたいのですが
 どのように直したらよいのか分かりません。

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

 > このシートをコピーして５月、６月とシートを増やして使いたいのですが
 > どのように直したらよいのか分かりません。

 まず短くまとめると以下のような感じになります。

 Sub 集計2()

    Columns("L:BD").Delete Shift:=xlToLeft
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "給料４月!R2C1:R2000C10").CreatePivotTable TableDestination:= _
        "[日払管理表.xls]給料４月!R3C12", TableName:="ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4", DefaultVersion:= _
        xlPivotTableVersion10
    With ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4").PivotFields("氏名")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4").PivotFields("日")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4").AddDataField ActiveSheet.PivotTables( _
        "ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4").PivotFields("支払"), "データの個数 / 支払", xlCount
    ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4").PivotFields("データの個数 / 支払").Function = _
        xlSum

    With Columns("L:BQ")
      .Interior.ColorIndex = xlNone
      .Value = .Value
      .NumberFormatLocal = "#,##0;[赤]-#,##0"
    End With

    Range("L3").FormulaR1C1 = "=R[-2]C[-11]"
    Range("L3").Select
 End Sub

 > このシートをコピーして５月、６月とシートを増やして使いたい

 どのように使いたいのでしょうか？
   "給料４月!R2C1:R2000C10"
 と
   "[日払管理表.xls]給料４月!R3C12"
 の部分を修正するといいと思うのですが、

 セル範囲は、どのシートも固定なのでしょうか？

 (かみちゃん)
 2009-04-22 14:32

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

 > まず短くまとめると以下のような感じになります。

 申し訳ありません。訂正です。

 L列～は、ピボットテーブルになっているので、

    With Columns("L:BQ")
      .Interior.ColorIndex = xlNone
      .Value = .Value
      .NumberFormatLocal = "#,##0;[赤]-#,##0"
    End With

 の部分は、以下のようにしないといけません。

    With Columns("L:BQ")
      .Interior.ColorIndex = xlNone
      .Copy
      .PasteSpecial Paste:=xlPasteValues
      .NumberFormatLocal = "#,##0;[赤]-#,##0"
    End With

 (かみちゃん)
 2009-04-22 14:46

 かみちゃんさん

 セル範囲は同じです。 ４月給料シートをコピーして５月給料シート、６月給料シートと毎月
 シートを増やして使いたいのですが、 "給料４月!R2C1:R2000C10"この部分がシート名を変え
 るとエラーになるので、シート名を指定しないで今開いているシート？みたいなコードに直したいです。

 説明が下手ですみません。
 （ちるちる）

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

 > まず短くまとめると以下のような感じになります。

 たびたび申し訳ありません。

 提示されたコードにおいて、
 "[日払管理表.xls]給料４月!R3C12"
 となっているのですが、
 Excel2003 SP3 で、サンプルシートを作って、
 "給料４月!R2C1:R2000C10" のセル範囲が含まれるブックをアクティブにした状態で
 コードをそのまま実行すると、
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "給料４月!R2C1:R2000C10").CreatePivotTable TableDestination:= _
        "[日払管理表.xls]給料４月!R3C12", TableName:="ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4", DefaultVersion:= _
        xlPivotTableVersion10
 の行で、
 「プロシージャの呼び出し、または引数が不正です」
 というエラーになります。
 CreatePivotTable メソッドのヘルプを見ると、
 TableDestination　には、
 「PivotCache オブジェクトが含まれているブックのワークシート上を指定してください」
 となっています。
 つまり、マクロ実行時は、日払管理表.xls をアクティブにしておく必要があり、
 そうなると、
 "給料４月!R2C1:R2000C10"
 も、
 "[Book1.xls]給料４月!R2C1:R2000C10"
 と、ピボットテーブルの元データのセル範囲をブック名から指定しないといけないのではないでしょうか？

 以上のことから、私なら、以下のようにします。

 Sub 集計4()
   Dim rngData As Range
   Dim rngPVt As Range
   Dim pvt As PivotTable

   Set rngData = ThisWorkbook.Worksheets("給料４月").Range("A2:J1000")
   Set rngPVt = Workbooks("日払管理表.xls").Worksheets("給料４月").Range("L3")

   rngPVt.Parent.Parent.Activate
   Set pvt = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rngData).CreatePivotTable(rngPVt)

   With pvt
     With .PivotFields("氏名")
         .Orientation = xlRowField
         .Position = 1
     End With
     With .PivotFields("日")
         .Orientation = xlColumnField
         .Position = 1
     End With
     .AddDataField .PivotFields("支払"), "データの個数 / 支払", xlCount
     .PivotFields("データの個数 / 支払").Function = xlSum

     With .TableRange2
       .Interior.ColorIndex = xlNone
       .Copy
       .PasteSpecial Paste:=xlPasteValues
       .NumberFormatLocal = "#,##0;[赤]-#,##0"
       .Cells(1, 1).FormulaR1C1 = "=R[-2]C[-11]"
     End With
   End With
   MsgBox "終了しました"
 End Sub

 (かみちゃん)
 2009-04-22 15:40

 かみちゃんさん

 たびたびすみません。ThisWorkbook.Worksheets("給料４月").Range("A2:J1000")
 この部分は5月給料シートだと5月給料シートのA2:J1000になり6月給料シートのA2:J1000
 と各シート内のA2:J1000になります。

 (ちるちる）

 範囲が固定の様ですので、毎回ピボットテーブルを作成しなくても
 ピボットテーブルが作成されているシートを一枚作っておいて
 　１．ピボットテーブルのあるシートのデータを
 　　　集計したいデータに変更する
 　２．ピボットテーブルを更新する
 　３．ピボットテーブルをコピーする
 　４．元のシートに貼り付ける
 と言う流れにしても良さそうに思います。

 例えば、ピボットテーブルの有るシートを
 「ピボットシート」とし、「ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4」と言う名前の
 ピボットテーブルが作ってあった場合

 '------
Sub 結果だけ()
    With Sheets("ピボットシート")
        .Range("A2:J2000").Value = Range("A2:J2000").Value
        .PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ4").PivotCache.Refresh

        Columns("L:BQ").Delete Shift:=xlToLeft
        .Range("L1:BQ" & .Range("L" & Rows.Count).End(xlUp).Row).Copy
        Range("L1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Columns("L:BQ").Style = "Comma [0]"
        Range("L3").FormulaR1C1 = "=R[-2]C[-11]"
        Range("L3").Select
    End With
End Sub
 '------

 (HANA)

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

 > シート名を指定しないで今開いているシート？みたいなコードに直したい

 一例として、
 2009-04-22 15:40
 で提示した
 Sub 集計4()
 をベースにするならば、

   Set rngData = ThisWorkbook.Worksheets("給料４月").Range("A2:J1000")
   Set rngPVt = Workbooks("日払管理表.xls").Worksheets("給料４月").Range("L3")

 の部分を

   Set rngData = ThisWorkbook.ActiveSheet.Range("A2:J1000")
   Set rngPVt = Workbooks("日払管理表.xls").Worksheets(rngData.Parent.Name).Range("L3")

 とすれば、できると思います。
 なお、マクロを記述するのは、ピボットテーブルの元データがあるシートのブックに
 しています。
 日払管理表.xls に記述するならば、 ThisWorkbook の部分を修正することになります。
 また、２つのブックには、同じ名前のシートが必ず存在することが必要です。

 (かみちゃん)
 2009-04-22 16:44

コメント返信：

[ 一覧(最新更新順) ]

[[20090422141823]] 『マクロでピボットテーブル』（ちるちる） ページの最後に飛ぶ

[[20090422141823]]　『マクロでピボットテーブル』（ちるちる）　ページの最後に飛ぶ