ピポットテーブルウィーザードを用いてピポットテーブル作成時にマクロの自動記録を実行し以下が記録されました。データの範囲を列方向と行方向のデータの終りまでに設定するにはどのように書きなおせばいいかご教示いただければ幸いです。


Sub ピポットテーブル作成()
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"main!R1C1:R6C7").CreatePivotTable TableDestination:="", TableName:= _
"ピボットテーブル6", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("ピボットテーブル6").PivotFields("仕入先")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("ピボットテーブル6").PivotFields("支払月")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("ピボットテーブル6").AddDataField ActiveSheet.PivotTables( _
"ピボットテーブル6").PivotFields("支払い額"), "合計 / 支払い額", xlSum
ActiveWorkbook.ShowPivotTableFieldList = False
End Sub

回答の条件
  • 1人2回まで
  • 13歳以上
  • 登録:2010/09/04 19:08:00
  • 終了:2010/09/11 19:10:02

ベストアンサー

id:ycyc No.3

ycyc回答回数37ベストアンサー獲得回数62010/09/08 01:42:32

ポイント26pt

●「データの終りまで」というのが曲者で、excelにはデータの終わりを取得する方法がいくつかあります。


「A列に入力されている最後の行」を取得するのがwindofjulyさんの方法です。

【参考】

http://www.niji.or.jp/home/toru/notes/8.html で記述されている「書式付きセルを除外する」方法でサンプルを書いてみました。

●もうひとつ引っかかるのが、pivotテーブルを何回も書いていると、テーブル名が重複して、エラーになるケースがあります。ので、テーブル名を"ピボットテーブル1"として、存在すれば、削除するようにしました。

●割とよくありがちなVBAの失敗として、Selectionとか、ActiveBook,ActieSheetとかを使うと、デバッグしているときにSelectionが変わってしまって、わけがわからない動きになることがあります。ので、Active~を最小にしました。

Sub ピポットテーブル作成()
    Dim book As Workbook
    Set book = ActiveWorkbook
    Dim dataSheet As Worksheet
    Dim pivotSheet As Worksheet
    Set dataSheet = book.Worksheets("main") ' データシート名はmainです
    Set pivotSheet = book.Worksheets("pivot") ' ピボットテーブルを作るシートはpivotです
    
    '最大行、最大列を求める
    Dim maxRow As Long
    Dim maxCol As Long
    With dataSheet.UsedRange
        maxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).row
        maxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    End With
    Dim area As Range
    Set area = dataSheet.Range( _
        dataSheet.Cells(1, 1), _
        dataSheet.Cells(maxRow, maxCol))
    
    ' ピボットテーブル名
    Dim pivotName As String
    pivotName = "ピボットテーブル1"
    Call removePivot(pivotSheet, pivotName)
    
    book.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=area) _
        .CreatePivotTable _
            TableDestination:=pivotSheet.Range("A3"), _
            TableName:=pivotName, _
            DefaultVersion:=xlPivotTableVersion10
    book.ShowPivotTableFieldList = True
    With pivotSheet.PivotTables(pivotName).PivotFields("仕入先")
        .Orientation = xlRowField
        .Position = 1
    End With
    With pivotSheet.PivotTables(pivotName).PivotFields("支払月")
        .Orientation = xlColumnField
        .Position = 1
    End With
    pivotSheet.PivotTables(pivotName).AddDataField _
        pivotSheet.PivotTables(pivotName).PivotFields("支払い額"), "合計 / 支払い額", xlSum
    book.ShowPivotTableFieldList = False
End Sub
' 既存のピボットテーブルを削除
Private Sub removePivot(pivotSheet As Worksheet, pivotName)
    On Error GoTo OnError
    pivotSheet.PivotTables(pivotName).PivotSelect "", xlDataAndLabel, True
    Selection.ClearContents
OnError:
    ' 存在しなければエラーになります
End Sub

その他の回答(3件)

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982010/09/04 19:44:54

ポイント27pt

>データの範囲を列方向と行方向のデータの終りまでに設定するには

この内容が 理解しかねます。

マクロの記録が出来るのでしたら、

データの範囲を列方向と行方向のデータの終りまでに設定

してから 再度 マクロの記録を とってみたらいかがでしょうか?

id:windofjuly No.2

うぃんど回答回数2625ベストアンサー獲得回数11492010/09/04 19:51:34

ポイント27pt

【1】変更箇所(アンダーバーで繋がっているので3行ではありますが1行という扱いになります)

    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    "main!R1C1:R6C7").CreatePivotTable TableDestination:="", TableName:= _
    "ピボットテーブル6", DefaultVersion:=xlPivotTableVersion10

【2】変更後

    Dim lasrRow As Integer
    lastRow = Range("a65536").End(xlUp).Row

    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    "main!R1C1:R6C" & i).CreatePivotTable TableDestination:="", TableName:= _
    "ピボットテーブル6", DefaultVersion:=xlPivotTableVersion10

【3】説明

RはRow(行)、CはColumn(列)を意味しますのでR1C1:R6C7はA1:G7という範囲指定と同じ意味になります

マクロを作成した時の最終行が7となっていますので、7の部分を可変に変えました

id:ycyc No.3

ycyc回答回数37ベストアンサー獲得回数62010/09/08 01:42:32ここでベストアンサー

ポイント26pt

●「データの終りまで」というのが曲者で、excelにはデータの終わりを取得する方法がいくつかあります。


「A列に入力されている最後の行」を取得するのがwindofjulyさんの方法です。

【参考】

http://www.niji.or.jp/home/toru/notes/8.html で記述されている「書式付きセルを除外する」方法でサンプルを書いてみました。

●もうひとつ引っかかるのが、pivotテーブルを何回も書いていると、テーブル名が重複して、エラーになるケースがあります。ので、テーブル名を"ピボットテーブル1"として、存在すれば、削除するようにしました。

●割とよくありがちなVBAの失敗として、Selectionとか、ActiveBook,ActieSheetとかを使うと、デバッグしているときにSelectionが変わってしまって、わけがわからない動きになることがあります。ので、Active~を最小にしました。

Sub ピポットテーブル作成()
    Dim book As Workbook
    Set book = ActiveWorkbook
    Dim dataSheet As Worksheet
    Dim pivotSheet As Worksheet
    Set dataSheet = book.Worksheets("main") ' データシート名はmainです
    Set pivotSheet = book.Worksheets("pivot") ' ピボットテーブルを作るシートはpivotです
    
    '最大行、最大列を求める
    Dim maxRow As Long
    Dim maxCol As Long
    With dataSheet.UsedRange
        maxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).row
        maxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    End With
    Dim area As Range
    Set area = dataSheet.Range( _
        dataSheet.Cells(1, 1), _
        dataSheet.Cells(maxRow, maxCol))
    
    ' ピボットテーブル名
    Dim pivotName As String
    pivotName = "ピボットテーブル1"
    Call removePivot(pivotSheet, pivotName)
    
    book.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=area) _
        .CreatePivotTable _
            TableDestination:=pivotSheet.Range("A3"), _
            TableName:=pivotName, _
            DefaultVersion:=xlPivotTableVersion10
    book.ShowPivotTableFieldList = True
    With pivotSheet.PivotTables(pivotName).PivotFields("仕入先")
        .Orientation = xlRowField
        .Position = 1
    End With
    With pivotSheet.PivotTables(pivotName).PivotFields("支払月")
        .Orientation = xlColumnField
        .Position = 1
    End With
    pivotSheet.PivotTables(pivotName).AddDataField _
        pivotSheet.PivotTables(pivotName).PivotFields("支払い額"), "合計 / 支払い額", xlSum
    book.ShowPivotTableFieldList = False
End Sub
' 既存のピボットテーブルを削除
Private Sub removePivot(pivotSheet As Worksheet, pivotName)
    On Error GoTo OnError
    pivotSheet.PivotTables(pivotName).PivotSelect "", xlDataAndLabel, True
    Selection.ClearContents
OnError:
    ' 存在しなければエラーになります
End Sub

id:simoke123 No.4

simoke123回答回数220ベストアンサー獲得回数02010/09/09 23:38:28

ポイント10pt (はてなにより削除しました)

コメントはまだありません

この質問への反応(ブックマークコメント)

トラックバック

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません