ピポットをマクロ登録したのですが

質問

ピポットをマクロに自動登録しました。ところが作動するとデバックが起きてしまいます。ＶＢＡに特別なプログラムを付け加える必要があるのでしょうか？　初心者なので勉強不足のところが多いのですが、どうかよろしくお願いします。

なお、シートは3枚で「data」「number」「answer」があり、「data」には価格の情報がないので、「number」シートからvlookupで情報を拾ってきています。ピポットは「answer」シートに作り、値の貼り付けをしてセルＡ１の列幅を20にしています。

Range("D1").Select
ActiveCell.FormulaR1C1 = "担当" 　　
ActiveCell.Characters(1, 2).PhoneticCharacters = "タントウ"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R2C1:R92C1,number!R2C1:R109C2,2,0)"　　
Selection.AutoFill Destination:=Range("D2:D92"), Type:=xlFillDefault
Range("D2:D92").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select
Application.CutCopyMode = False
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"data!R1C1:R92C4").CreatePivotTable TableDestination:="[集計(1).xls]answer!R1C1" _
, TableName:="ピボットテーブル1", DefaultVersion:=xlPivotTableVersion10
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("性別")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("商品番号")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("担当")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("ピボットテーブル1").PivotSelect "商品番号[All]", xlLabelOnly, _
True
Range("B2").Select
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("商品番号").Orientation = _
xlHidden
ActiveSheet.PivotTables("ピボットテーブル1").AddDataField ActiveSheet.PivotTables( _
"ピボットテーブル1").PivotFields("価格"), "合計 / 価格", xlSum
Columns("A:A").Select
Selection.ColumnWidth = 20
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

回答No.3

OtenkiAme · ベストアンサー

こんにちは。

作った集計表を数値化していますが、
TableName:="ピボットテーブル1"　のピボットテーブルが存在するとか、TableDestination:="[集計(1).xls]answer!R1C1"のブック名が異なっているとか、確認してみてください。
省略できる引数もあるので、ヘルプファイルを活用して、分からないコードは調べるクセをつけるといいですよ。

作成先のシートを指定している場合は、
一旦、シートのセルをクリアしてから作成するのが常套手段だと思います。

また、複数のピボットテーブルを操作するのでなければ、
名前を省略して、INDEXで指定してあげると処理がすっきりします。

また、ピボットテーブルの作成は、手作業での手順が把握できたら、
ウィザード3/3のレイアウトで組むようにするといいです。
ワークシートで組むのと違ってすっきりしたコードが書けます。

記録したコードの編集ですが、
ほとんど場合、□.Select、Selection.△と続く処理は、□.△というようにつないで書くことができます。画面のちらつきもなくなりますし、
処理が早くなります。ぜひコードの編集にチャレンジしてください。

下に、サンプルを掲示しますので、F8でステップ実行しながら、
murasakishさんの処理の参考にしてみてください。

Sub 例えば()

With Worksheets("data")
　　.Range("D1").Value = "担当"
　　With .Range("D2")
　　　　.FormulaR1C1 = "=VLOOKUP(R2C1,number!R2C1:R109C2,2,0)"
　　　　.AutoFill Destination:=.Parent.Range("D2:D92"), Type:=xlFillDefault
　　End With
　　With .Range("D2:D92")
　　　　.Copy
　　　　.PasteSpecial Paste:=xlPasteValues, _
　　　　　　Operation:=xlNone, SkipBlanks:=False, Transpose:=False
　　End With
　　Application.Goto Reference:=.Range("A2")
End With

Worksheets("answer").Cells.Clear

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
　　SourceData:=Worksheets("data").Range("A1").CurrentRegion.Address(External:=True)) _
　　.CreatePivotTable TableDestination:=Worksheets("answer").Range("A1")

With Worksheets("answer")

　　.Activate

　　With .PivotTables(1)
　　　　.PivotFields("商品番号").Subtotals(1) = False
　　　　.AddFields RowFields:=Array("商品番号", "担当"), ColumnFields:="性別"
　　　　.PivotFields("価格").Orientation = xlDataField

　　　　With .TableRange1
　　　　　　.Copy
　　　　　　.PasteSpecial Paste:=xlPasteValues, _
　　　　　　　　Operation:=xlNone, SkipBlanks:=False, Transpose:=False
　　　　　　Application.CutCopyMode = False
　　　　　　.Interior.ColorIndex = xlNone
　　　　　　Application.Goto Reference:=.Range("A1")
　　　　End With

　　End With
　　.Columns("A:A").ColumnWidth = 20
End With

End Sub

お礼

ご丁寧にありがとうございます。参考にさせていただいたら動くようになりました。F8でのステップ実行、これから習慣にします。

回答No.2

KenKen_SP

エラーの内容（エラー番号、メッセージ）とか、状況（例えば１回目は
上手くいくのに２回目は失敗するとか）の説明がないと回答側にはエラー
の原因がつかめません。

なぜなら、コードには問題がなく、シート上のデータ側に問題があるなど
コード上では読み取れない原因があるのかもしれないからです。
そのため、少なくともこのような情報の提供が必要なのです。

で、気になる点を。

> [集計(1).xls]answer!R1C1

という表記はおかしくないですか？単に answer!R1C1 にしてみたら？

お礼

自動記録で作ったので可笑しいところには気がつきませんでした。これでも実行されましたので、ここが原因ではなかったようですが…。今後のこともありますので覚えるようにします。ありがとうございました。

回答No.1

KenKen_SP

> ところが作動するとデバックが起きてしまいます。

どの行でエラーになるのかを書かないと。。それから、どのような状況で
エラーになるのかの説明、Excel や OS のバージョン等も書かないと。。

試してないけど、とりあえず気づいた部分です。

■ [追加] 1行目にシートのアクティブ化コード
Range("D1").Select
ActiveCell.FormulaR1C1 = "担当"
　　　↓
Worksheets("data").Activate
Range("D1").Select
ActiveCell.FormulaR1C1 = "担当"

■ [修正]VLOOKUP 関数の第一引数がヘン
ActiveCell.FormulaR1C1 = "=VLOOKUP(R2C1:R92C1,number!R2C1:R109C2,2,0)"
　　　↓
ActiveCell.FormulaR1C1 = "=VLOOKUP(R2C1,number!R2C1:R109C2,2,0)"

■ [追加] シートのアクティブ化コード
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("性別")
↓
Worksheets("answer").Activate
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("性別")

補足

Excel2003です。失礼しました。VBA用に書き直しました。デバックが起きるのは※の部分です。

Dim L As Integer
Worksheets("data").Activate
Range("D1").Select
ActiveCell.FormulaR1C1 = "担当"
Range("D2").Select

ActiveCell.FormulaR1C1 = "=VLOOKUP(R2C1,number!R2C1:R109C2,2,0)"
Selection.AutoFill Destination:=Range("D2:D92"), Type:=xlFillDefault

Range("D2:D92").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select

Sheets("answer").Select
Range("A1").Select

Worksheets("answer").Activate

※ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"data!R1C1:R92C4").CreatePivotTable TableDestination:="[集計(1).xls]answer!R1C1" _
, TableName:="ピボットテーブル1", DefaultVersion:=xlPivotTableVersion10
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("性別")
Worksheets("answer").Activate
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("商品番号")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("担当")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("ピボットテーブル1").PivotSelect "商品番号[All]", xlLabelOnly, _
True
Range("B2").Select
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("商品番号").Orientation = _
xlHidden
ActiveSheet.PivotTables("ピボットテーブル1").AddDataField ActiveSheet.PivotTables( _
"ピボットテーブル1").PivotFields("価格"), "合計 / 価格", xlSum

Columns("A:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A21").Select

End Sub

よろしくお願いします。