[[20050604034902]]　『ピポットテーブルのデータ範囲の更新』（のＶｉた）　ページの最後に飛ぶ

『ピポットテーブルのデータ範囲の更新』（のＶｉた）

 今回はピポットテーブルについてお教えください。
ピポットテーブルのデーター範囲となるシートへ別の入力用シートからマクロで
現在有るデーターの最後尾に新しいデーターを追加する様に転送してデーターを増やしています。
ところが一番最初ピポットテーブル新規作成時にまとめて入力したデーターの範囲分しか集計してくれません。
新しくデーターを追加してデーター範囲が変化したら(増えたら)ピポットテーブルの集計対象範囲も
勝手に(と言うか自動的に）変化して新しいデーターも集計し直してくれる様に出来ないでしょうか？

 データの範囲がA1からあって同じシートにある一つ目のピボットテーブルなら、
こんな感じでどうでしょうか？
シートの見出しを右クリック→コードを表示させてそこに貼り付けます。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyData As String
On Error GoTo MyLine
With Me
    If .PivotTables.Count > 0 Then
        MyData = .Range("A1").CurrentRegion.Address
        .PivotTables(1).PivotTableWizard SourceType:=xlDatabase, SourceData:=MyData
    End If
End With
Exit Sub
MyLine:
With Application
    .EnableEvents = False
        MsgBox "エラーNo　" & Err.Number & vbCrLf & _
            Err.Description
    .Undo
    .EnableEvents = True
End With
End Sub
あまりにもエラーが多いのでちょっと追加汗
（SoulMan）

 ピポットテーブルは別シートなので、ピポットテーブルのシートにコードを貼り付けてやってみましたが
エラー1004　'Undo'メソッドは失敗しました'_Application'オブジェクト　ってエラーが出ます。
原因は何なのか教えて下さい。できたらコードの解説もお願いいたします。
(のＶｉた)

 おぅのぅ～～｡･ﾟﾟ･(>_<)･ﾟﾟ･｡
違うシートやったらあかんやんね？？？
 >できたらコードの解説もお願いいたします。
 説明も何もわたしゃピボットってのをやったことがないもんで
マクロの記録でウィザードの戻る→データ範囲を選択し直しただけざんす。（￣□￣；）！！
ということで、同じシートだったらいいみたいなので、ちょっとコードを追加して
例えばSheet1のA1から元データがあったとしたら、Sheet1を変更すると
Sheet2に移る様にしておきます。で、ピボットはSheet2のそこを参照する様にして
もらえませんでしょうか？ちょっと他にないか考えてはみますが、、
とりあえず、↓このコードをSheet1に貼り付けてください。
データのあるシートです。
MyDesを変えると出力先が変わりますから目障りな時はどこか遠いところを
指定しておいてください。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyDes As Range
Set MyDes = Sheets("Sheet2").Range("A1")
With Me.Range("A1").CurrentRegion
    MyDes.CurrentRegion.ClearContents
    MyDes.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End Sub
次に↓このコードをピボットのあるSheetに貼り付けてください。
データの範囲はMyDataにしてます。今はA1からあるアクティブな範囲です。
上のコードをあわせて変更してください。
Undoは同じシートならOKでしただ違うシートとなるとこれもダメっぽいので
データのシートに戻る様にSelectに変更しました。
Option Explicit
Private Sub Worksheet_Activate()
Dim MyData As String
On Error GoTo MyLine
With Me
    MyData = .Range("A1").CurrentRegion.Address
    If .PivotTables.Count > 0 Then
        .PivotTables(1).PivotTableWizard SourceType:=xlDatabase, SourceData:=MyData
    End If
End With
Exit Sub
MyLine:
With Application
    .EnableEvents = False
        MsgBox "エラーNo　" & Err.Number & vbCrLf & _
            Err.Description
        Sheets("Sheet1").Select 'Undoの代わりにデータのシートに戻る様にしました。
    .EnableEvents = True
End With
End Sub
こんな感じでどうでしょうか？？？
（SoulMan）

 だめでした。
エラno.1004　フィールド名が正しくない、というエラーが出てピポットのシートがアクティブにできません。
データーシートのA4にラベルがあるので（データーの数字はA5からです）
MyData = .Range("A4").CurrentRegion.Address
にしたんですが・・・。
(のＶｉた)

 簡単なサンプルを作ってみましたのでお試しください。
ピボットは？？？？です。(^^;
http://ryusendo.no-ip.com/cgi-bin/upload/src/up0324.xls
（SoulMan）

 おまたせ～～！！
やっと出来たみたいです。（難産でした(ｰｰ;)）
どうも、RC形式じゃないとExcel君は機嫌が悪いみたいです。
ということで、、UnDoも復活です。一応、テストはしてあります。。
お試しください。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyData As String
On Error GoTo MyLine
    With Me
        MyData = .Name & "!" & .Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)
    End With
    With Sheets("Sheet2")
        If .PivotTables.Count > 0 Then
            .PivotTables(1).PivotTableWizard SourceType:=xlDatabase, SourceData:=MyData
        End If
    End With
Exit Sub
MyLine:
With Application
    .EnableEvents = False
        MsgBox "エラーNo　" & Err.Number & vbCrLf & _
            Err.Description
    .Undo
    .EnableEvents = True
End With
End Sub
（SoulMan）

 解決しているようですが、こんな方法でもよいのでは？
 ピボットテーブルのデータ範囲ですが、少し多めに行を指定しておき、
 入力データシートに、データを追加するときには、行挿入の形でデータ追加をすれば
 ピボットテーブルの範囲も自動的に変動してくれると思いますので、
 一度試してみて下さい。（スー）

 お返事が遅くなりました。
別sheetにすると、あれこれわかる範囲でいじくってみてもうまくいかなかったので。
 (SoulMan）さんがRC形式を書き込みされたのをみる前にサンプルの様に同一sheet上ので完成してました。
（夜遅いのにどうもありがとうございました！）
で、一応RC形式のもコピーしてあれこれしてみましたが、あれこれのやり方がまずいのか
エラーが出てうまくいきませんでした。
（何がいけないのかわからず非常に歯がゆいです。まだまだ修行が足りません・・・）
最終的に下記の様になり順調に作動する様になりました。
Dim MyData1 As String
Dim MyData2 As String
Dim MyData3 As String
Dim MyRow As Long
MyRow = Range("A65536").End(xlUp).Row
On Error GoTo MyLine
With Me
    MyData1 = .Range("A4:I" & MyRow).Address
    If .PivotTables.Count > 0 Then
    .PivotTables(1).PivotTableWizard SourceType:=xlDatabase, SourceData:=MyData1
    .PivotTables(2).PivotTableWizard SourceType:=xlDatabase, SourceData:=MyData1
    .PivotTables(3).PivotTableWizard SourceType:=xlDatabase, SourceData:=MyData1
End If
End With
Exit Sub
MyLine:
With Application
    .EnableEvents = False
        MsgBox "エラーNo　" & Err.Number & vbCrLf & _
            Err.Description
        Sheets("ﾃﾞｰﾀｼｰﾄ").Select 'Undoの代わりにデータのシートに戻る様にしました。
    .EnableEvents = True
End With
End Sub
右の方のセルが入力値有ったり無かったり（備考なので）するので過去ログから少しいただいて手を加えました。
これも(SoulMan)さんのだったかもしれません。
(ついでなんでピポットも２個追加しちゃいました。)
(スー)さんもアドバイスありがとうございます。
次回機会が有れば試したく思います。
又よろしくお願いいたします。
(のＶｉた)

 うぅ～～ん、、解決しちゃったから別にいいですけどね、
このコードをデータのあるシートに貼り付けてみてください。
Sheets("ピボットのあるシート")
これは実際のシート名に変えてください。
ピボットの作り方が今一私はわからないのでなんとも言えませんが、
多分、、いいと思いますよ。。
ではでは、、
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyData1 As String
Dim MyRow As Long
Dim i As Long
On Error GoTo MyLine
With Me
    MyRow = .Range("A65536").End(xlUp).Row
    MyData1 = Me.Name & "!" & .Range("A4:I" & MyRow).Address(ReferenceStyle:=xlR1C1)
End With
With Sheets("ピボットのあるシート")
    If .PivotTables.Count >= 3 Then
        For i = 1 To 3
            .PivotTables(i).PivotTableWizard SourceType:=xlDatabase, SourceData:=MyData1
        Next
    End If
End With
Exit Sub
MyLine:
With Application
    .EnableEvents = False
        MsgBox "エラーNo　" & Err.Number & vbCrLf & _
            Err.Description
    .Undo
    .EnableEvents = True
End With
End Sub
（SoulMan）

 （SoulMan）さん、何度もありがとうございます。完璧でした！！。
今回はsheet名を変更した以外　何もしなくてもすんなり作動しました。
しかもデータシートからピポット同一シートへデーター転送させていたのを止めて
ピポットシートから直接データシートへ、データーを拾う様にしても大丈夫でした。
これで１番最初の形に戻せてファイルサイズも節約できました。
本当に感謝感激です。
（のＶｉた）

コメント返信：

[ 一覧(最新更新順) ]

[[20050604034902]] 『ピポットテーブルのデータ範囲の更新』（のＶｉた） ページの最後に飛ぶ

[[20050604034902]]　『ピポットテーブルのデータ範囲の更新』（のＶｉた）　ページの最後に飛ぶ