[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ＶＢＡピボットテーブルデータソース更新』（な）
お世話になっております。
ＶＢＡ初心者で失礼します。
ＶＢＡにて、ピボットテーブルの作成を複数シートに行うのですが、
１から作成するのではなくデータソース更新で
順々に作成したいと考えています。
そこで、ピボットテーブルのデータソース更新の構文を教えて頂きたく思います。
＜条件＞
・抽出データは、「◆.xlsx」にあります。
本ブックには、複数シートがあり、シートごとに下記＜やりたいこと＞の作業を行います。
・ピボットテーブルのひな形は、元データがある◆.xlsxとは別のブックに持っておきます。
ひな形のあるブック名：「データ更新シート.xlsx」
本ブックには、２シートあり、「貼り付け」と「ＰＴ」があります。
データソースのテーブル名を「hanni」に設定しています。
＜やりたいこと＞
１、「ひな形のあるブック：「データ更新シート.xlsx」貼り付け」シートに「◆.xlsx」の元データを貼り付けます。
２、「貼り付け」シートに元データ貼り付け後、ピボットテーブルひな形のある「ＰＴ」シートにて、データソース更新→すべて更新作業をし、ピボットテーブルを更新したいです。
以下のとおり、構文を記載しましたが、以下構文でエラーになってしまいます。
「Worksheets("ＰＴ").PivotTables("hanni").PivotCache.Refresh」
Sub ピボットデータ更新()
'
' ピボットデータ更新 Macro
'
Dim hanni As String
'抽出データをコピー
Windows("◆.xlsx").Activate
'2シート目を選択※2シート目から最終シートまで繰り返し
Worksheets(2).Select
ActiveWindow.WindowState = xlNormal
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'切り取り
Application.CutCopyMode = False
Selection.Cut
'切り取ったデータを貼り付け
Windows("データ更新シート.xlsx").Activate
Sheets("貼り付け").Select
ActiveSheet.Paste
'▼ピボットテーブルデータソース更新テスト中
Windows("データ更新シート.xlsx").Activate
Worksheets("ＰＴ").PivotTables("hanni").PivotCache.Refresh
'▲テスト中（終了）
End Sub
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
ひな形pvを新規シートにコピーします。（PTシートをPT（n）シートにコピーでも構いません。n=1 to ◆.xlsxのシート数分) コピーされたピボットテーブル（以下pv）のデータソースを◆.xlsxの各シートのデータ範囲とします。 pv.RefreshTableします。 pv.TableRange2.Copy: pv.TableRange2.Cells(1).PasteSpecial xlPasteValuesします。
（kazuo） 2020/03/30(月) 18:28
＞抽出データは、「◆.xlsx」にあります
＞ひな形のあるブック名：「データ更新シート.xlsx」
マクロのあるBook（拡張子.xlsm)がありません。
３つのBookを使うのですか？
もし、ひな形のあるブックを「データ更新シート.xlsm」 としてよいなら、
Sub ピボットデータ更新()
Dim pv As PivotTable
Dim sh As Worksheet
For Each sh In Workbooks("◆.xlsx").Worksheets
ThisWorkbook.Worksheets("PT").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set pv = ActiveSheet.PivotTables(1)
With pv
pv.SourceData = sh.Range("A2").CurrentRegion.Address(True, True, xlR1C1, True) '◆.xlsxの1行目は空白でA2セルからデータがあること
pv.TableRange2.Copy
pv.TableRange2.Cells(1).PasteSpecial xlPasteValues
Cells(1).Select
End With
Next
Application.CutCopyMode = False
End Sub
で良いと思います。
（kazuo） 2020/03/30(月) 20:15
頂いた構文を実行してみたところ、
以下部分にてエラーになってしまいました。
「インデックスが有効範囲にありません」となります。
PTは、データ更新シート.xlsmにあるシートと考えてよいのでしょうか。
◆.xlsxファイルにPTシートをコピーしてみましたが、
それもエラーになってしまいました。。。
ThisWorkbook.Worksheets("PT").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
（な） 2020/03/30(月) 23:35
でも、なさんのコードを読み返すと項目名だけを変更しているように見えます。
そうなら、私のはやっていることが違います。
あと、
＞ '2シート目を選択※2シート目から最終シートまで繰り返し
を見逃していました。以下に変えて動かないようなら再度どういったpivotを作りたいのか説明ください。
Sub ピボットデータ更新()
Dim pv As PivotTable
Dim sh As Worksheet
Dim i As Long
For i = 2 To Workbooks("◆.xlsx").Worksheets.Count
Set sh = Workbooks("◆.xlsx").Worksheets(i)
ThisWorkbook.Worksheets("ＰＴ").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set pv = ActiveSheet.PivotTables(1)
With pv
pv.SourceData = sh.Range("A2").CurrentRegion.Address(True, True, xlR1C1, True) '◆.xlsxの1行目は空白でA2セルからデータがあること
pv.TableRange2.Copy
pv.TableRange2.Cells(1).PasteSpecial xlPasteValues
Cells(1).Select
End With
Next
Application.CutCopyMode = False
End Sub
（kazuo） 2020/03/31(火) 07:54
説明不足で大変申し訳ありません。
やりたいこととしては、
１、「◆.xlsx」にある元データを、「データ更新シート.xlsm」の「貼り付け」シートに切り取りコピー。
２、「ＰＴ」シートのピボットテーブルのデータソースを更新。貼り付けシートのデータをＰＴシートに反映させる。
３、ＰＴシートにできたデータを、「◆.xlsx」にある切り取りした部分に値貼り付けする。
※この作業を「◆.xlsx」にあるシート分だけ繰り返します。
１と３は自分で出来そうなのですが、２の構文がわからず、質問させていただきました。
何度も申し訳ありませんが、可能でしたらご教授よろしくお願いいたします。
（な） 2020/03/31(火) 10:10
Sub test()
On Error Resume Next
Debug.Print ThisWorkbook.Name
For i = 1 To Workbooks.Count
Debug.Print Workbooks(i).Name; " 1: " & Workbooks(i).Worksheets(1).Name, "2: " & Workbooks(i).Worksheets(2).Name
Next
On Error GoTo 0
End Sub
を実施して、VBE画面でCtrl + g してイミディエイトウィンドウを出して
出力された文字を貼り付け下さい。
（kazuo） 2020/03/31(火) 11:16
イミディエイトウインドウで出力された文字を添付します。
＜イミディエイトウインドウで出力された文字＞
テスト中（出来上がったら差し替え）：マクロ（自由分析）名前を付けて保存追加.xlsm
データ更新シート.xlsm 1: ＰＴ 2: 貼り付け
◆.xlsx 1: Sheet1 2: ＡＡＡ??
＜な コメント＞
※◆ブックの2には、元データとなる2シート目の企業名が記載されています。
お手数おかけしますが、よろしくお願いいたします。
（な） 2020/03/31(火) 12:20
とりあえず、データ更新シート.xlsm はすでに xlsmに変えてしまったので、これに、マクロを貼り付けて実施してください。
そして、ＰＴ(2)からＰＴ(n)にデータができ、それが（◆.xlsxの各シートに）欲しいものか お知らせ下さい。
また、もとのようにBookは３つ必要ですか。◆.xlsx 、データ更新シート.xlsx 、仮前を付けて保存追加.xlsm
（kazuo） 2020/03/31(火) 12:39
頂いたコードでほぼやりたいことができました！
＞bookは３つですか。
申し訳ありません、２つで大丈夫です。
◆.xlsx 、データ更新シート.xlsx
後々、ピボットテーブル操作を行い、形式を整えた後、
年月を名前に入れて保存する予定です。
これを合わせれば３つになります。
1点だけ、可能でしたら教えてください。。
上のやり取りで「３」は自分でできそうとお伝えしましたが、
うまくいかず、、、。
＜やりたいこと＞
ピボットテーブル作成したデータを、
ＰＴのある「データ更新シート.xlsm 」にシート展開するのではなく、
「◆.xlsx 」ファイルの元データがあった部分に値貼り付けし、
シート展開したいです。
（この時、◆.xlsx の元データはクリアした状態）
頂いたコードで実験してみましたが、
依然として、ＰＴのある「データ更新シート.xlsm 」にシート展開のままになっております。
変更箇所、わかりましたら教えて頂ければ幸いです。
Sub ピボットデータ更新()
Dim pv As PivotTable
Dim sh As Worksheet
Dim i As Long
'◆ブックの2シート目以降シート分繰り返し処理
For i = 2 To Workbooks("◆.xlsx").Worksheets.Count
Set sh = Workbooks("◆.xlsx").Worksheets(i)
'ThisWorkbook＝「データ更新シート」ブック
ThisWorkbook.Worksheets("ＰＴ").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set pv = ActiveSheet.PivotTables(1)
With pv
'◆.xlsxの元データを範囲コピー、「データ更新シート」ピボットデータソース更新
pv.SourceData = sh.Range("A2").CurrentRegion.Address(True, True, xlR1C1, True) '◆.xlsxの1行目は空白でA2セルからデータがあること
'更新したピボットテーブルをコピー
pv.TableRange2.Copy
'値貼り付け
pv.TableRange2.Cells(1).PasteSpecial xlPasteValues
Cells(1).Select
End With
’▼ここから自分で記載した構文
Windows("◆.xlsx").Activate
'元データの値クリア
ActiveWindow.WindowState = xlNormal
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A1").Select
'値貼り付け
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E6").Select
Next
Application.CutCopyMode = False
End Sub （na） 2020/03/31(火) 16:46
＞'抽出データをコピー ＞データソースのテーブル名を「hanni」に設定 で悩んでいました。フィルターはされていないのですね。
Sub ピボットデータ更新()
Dim pv As PivotTable
Dim sh As Worksheet
Dim i As Long
'◆ブックの2シート目以降シート分繰り返し処理
For i = 2 To Workbooks("◆.xlsx").Worksheets.Count
Set sh = Workbooks("◆.xlsx").Worksheets(i)
'ThisWorkbook＝「データ更新シート」ブック
Set pv = ThisWorkbook.Worksheets("ＰＴ").PivotTables(1)
'ピボットデータソースを◆.xlsxの元データを範囲とし「データ更新シート」のピボット更新
pv.SourceData = sh.Range("A2").CurrentRegion.Address(True, True, xlR1C1, True) '◆.xlsxの1行目は空白でA2セルからデータがあること
'元データの値クリア
sh.UsedRange.Clear
'更新したピボットテーブルをコピー
pv.TableRange2.Copy
'値貼り付け
sh.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.Goto sh.Range("E6") 'なぜにE6？
Next
Application.CutCopyMode = False
ThisWorkbook.Saved = True '保存せずに閉じたときメッセージを出さないよう変更無かったことにする
End Sub
（kazuo） 2020/03/31(火) 17:27
いくつか確認したいのですが、このトピックのはじめに提示されたコードを、提示された情報を元に整理してみるとこんな感じになるとおもいます。（ループ部分は除く）
Sub 整理()
Dim データソース As String
Dim dstWB As Workbook
Set dstWB = Workbooks("データ更新シート.xlsx")
'▼カット＆ペースト
With Workbooks("◆.xlsx").Worksheets(2)
.Range("A2", .Range("A2").End(xlDown)).EntireRow.Cut
.Paste Destination:=dstWB.Worksheets("貼り付け").Range("A2")
End With
'▼データソースをシート名も含めて取得する
データソース = Split(dstWB.Worksheets("貼り付け").Range("A2").CurrentRegion.Address(External:=True), "]")(1)
'▼「ＰＴ」シートの「hanni」というピボットテーブルのデータソースを更新する
dstWB.Worksheets("ＰＴ").PivotTables("hanni").ChangePivotCache _
Workbooks(dstWB.Name).PivotCaches. _
Create(SourceType:=xlDatabase, SourceData:=データソース)
End Sub
■１
上記のうち、ループ処理にしたい（次々に変えたい）部分はどこですか？
■２
カット＆ペーストではなく、コピー＆ペーストではダメなんですか？
（データ元消しちゃってもいいのかなぁと…）
（もこな２ ） 2020/03/31(火) 18:51
＞なぜにE6？
ここは、誤っていました。
A1セルに指定しなおしました。
とても勉強になりました。
（な） 2020/03/31(火) 23:17
kazuo様に頂いたコードで解決しましたが、
頂いたコード、解説付きで勉強になります。
今後の参考にさせていただきます。
有難うございます！！
ちなみに、カットペーストの後、シート完成後
別名でファイル保存をするため、元データは残せるような構成を考えております。
また、何かあれば相談させてください。
（な） 2020/03/31(火) 23:22
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.