[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ピポッドテーブルの貼付』（燦燦）
マクロでピポッドテーブルの値を別シートの表形式に合わせて貼付することは
できるのでしょうか？
データーを更新してピポッドテーブルを作成しております
１．ピポッドテーブルのA列〜D列は７行目から最終行までを別シート
の同じ列、26行目から貼付してます
２．ピポッドテーブルのE列からは5行目の種別に合わせて別シート
と同じ種別の列に貼付してます
（ピポッドテーブル）
A| B| C| D| E| F| G| H| I| J| 1| 2| 3| 4| N1| 5| K1| K2| 6| T1| T2| T3| T4| T5| T6| T7| T5| T6| T7| 7| a| b| c| d| e| f| g| h| i| j|
（別シート）
A| B| C| D| E| F| G| H| I| J| 20| 21| 22| 23| 24| K1| K2| 25| T1| T2| T3| T4| T5| T6| T7| T5| T6| T7| 26| a| b| c| d| e| f| g| h| i| j|
ピポッドテーブルがK1が無くて、K2しか無い時は別シートのK2の列に値を貼付したいのです
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
こんばんは ＾＾ ピボット専用の範囲指定方法もあるよぉ〜ですが、いつも通りの範囲指定 値貼付けでも、出来たよぉ〜な気がいたします。ご提示の内容でしたら、 基本、行をずらして、コピペでも。。。m(_ _)m （隠居じーさん） 2020/09/01(火) 18:10
E列からは5行目のK1〜K10（項目）によって6行目のタイトルは繰り返します（T5〜T7）
別シートはK1〜K10までの表が作ってあり、それにピポッドテーブルの値をコピー
してます
例えば下の図のように、ピポッドテーブルでK2とK3だけだった場合に別シートのK2と
K3の列に自動でコピーしてくるようにしたいのです
K1から順番でないときはどうしたらできるのかが分かりません
（ピポッドテーブル）
A| B| C| D| E| F| G| H| I| J| 1| 2| 3| 4| N1| 5| K2| K3| 6| T1| T2| T3| T4| T5| T6| T7| T5| T6| T7| 7| a| b| c| d| e| f| g| h| i| j|
（別シート）
A| B| C| D| E| F| G| H| I| J| 20| 21| 22| 23| 24| K1| K2| 25| T1| T2| T3| T4| T5| T6| T7| T5| T6| T7| 26| a| b| c| d| e| f| g| h| i| j|
（燦燦） 2020/09/02(水) 09:17
おはようございます ＾＾ あら？う〜ん。すみません。。。何となくわかりかけたよぉ〜な気はするのですが。。。 ↑の別シートは、処理前ですか。別シートの処理前と、処理後をご説明賜れば。お手伝い 出来るかもしれません。。。←解っていないのは私だけかもしれません。他の回答者様の アドバイスも引き続きお待ちくださいね(#^^#)ｖ。。。でわ 目印は。。。Ｔ5とその下のe Ｔ５とその下のｈ でしょうかね？？； （隠居じーさん） 2020/09/02(水) 09:53
おはようございます ＾＾ ３０分程眺めていますが。。。理解出来ません。相済みませ ん。私のコメントは全てスルーして下さい。是にて失礼致し ます。他の回答者様のレスをお待ちください。m(_ _)m （隠居じーさん） 2020/09/02(水) 10:57
●Kが1から順番（1、2、3、4〜10）だった時
K1のT5はe、T6はf、T7はg、
K2のT5はh、T6はi、T7はj
別シートも
K1のT5はe、T6はf、T7はg、
K2のT5はh、T6はi、T7はj
となるようにコピーします
手作業ならピポッドテーブルのE〜Gをコピーして、別シートの
H〜Jに貼り付けます
（ピポッドテーブル）
A| B| C| D| E| F| G| H| I| J| 1| 2| 3| 4| N1| 5| K1| K2| 6| T1| T2| T3| T4| T5| T6| T7| T5| T6| T7| 7| a| b| c| d| e| f| g| h| i| j|
（別シート）
A| B| C| D| E| F| G| H| I| J| 20| 21| 22| 23| 24| K1| K2| 25| T1| T2| T3| T4| T5| T6| T7| T5| T6| T7| 26| a| b| c| d| e| f| g| h| i| j|
●Kが1から順番でない時
例はK2から始まった場合です
K2のT5はh、T6はi、T7はj
K3のT5はk、T6はl、T7はm
別シートは
K1は空白
K2のT5はh、T6はi、T7はj
となるようにコピーします
（ピポッドテーブル）
A| B| C| D| E| F| G| H| I| J| 1| 2| 3| 4| N1| 5| K2| K3| 6| T1| T2| T3| T4| T5| T6| T7| T5| T6| T7| 7| a| b| c| d| h| i| j| k| l| m|
（別シート）
A| B| C| D| E| F| G| H| I| J| 20| 21| 22| 23| 24| K1| K2| 25| T1| T2| T3| T4| T5| T6| T7| T5| T6| T7| 26| a| b| c| d| | | | h| i| j|
（燦燦） 2020/09/02(水) 12:26
貼り付け先のセルを検索するには、
Sub test2()
Dim rngItemFrom As Range
Dim rngItemTo As Range
Dim c As Range
Dim ix As Long
With Worksheets("ピボット")
Set rngItemFrom = Intersect(.Rows(5), .UsedRange)
End With
Set rngItemTo = Worksheets("別シート").Rows(24)
For Each c In rngItemFrom
ix = 0
If Len(c.Value) > 0 Then
On Error Resume Next
ix = WorksheetFunction.Match(rngFrom.Value, rngItemTo, 0)
On Error GoTo 0
End If
If ix > 0 Then c.Copy rngItemTo(ix)
Next
End Sub
こんな感じです。
コピー元を巡回するには、
Sub test()
Dim myPVT As PivotTable
Dim f As PivotField
Dim o
Set myPVT = Worksheets("Sheet2").PivotTables(1)
Set f = myPVT.ColumnFields(1)
For Each o In f.PivotItems
MsgBox o.DataRange.Address
Next
End Sub
こんな感じです。
この二つをたたき台に一連の作業にまとめてみましょう。
（まっつわん） 2020/09/02(水) 14:54
Set rngItemTo = Worksheets("別シート").Rows(24) Set rngItemTo = Worksheets("別シート").Rows(24).cells
です。修正願います。
まとめたコードは、またあとで書きます。
暑いからジュースを差し入れせんと。。。
（まっつわん） 2020/09/02(水) 14:58
まとめてみました。
Sub メイン()
Dim o As PivotItem
Dim rngTo As Range
For Each o In Worksheets("ピボット").PivotTables(1).ColumnFields(1).PivotItems
Set rngTo = GetPasteRange(o.Name)
If Not rngTo Is Nothing Then
o.DataRange.Copy GetPasteCell(o.Name)
End If
Next
End Sub
Function GetPasteCell(ByVal sName As String) As Range
Dim rngTo As Range: Set rngTo = Worksheets("別シート").Rows(24).Cells
Dim ix As Long
On Error Resume Next
ix = WorksheetFunction.Match(sName, rngTo, 0)
On Error GoTo 0
If ix > 0 Then Set GetPasteRange = rngTo(ix)
End Function
（まっつわん） 2020/09/02(水) 15:56
「SubまたはFunctionが定義されていない」とメッセージがでます
昨日、色々やってみましたが自分の能力ではお手上げです
（燦燦） 2020/09/03(木) 12:52
ピポッドテーブルの7行目以降が別シートの26行目以降にコピー
されるのでしょうか？
また、Set rngTo = GetPasteRange(o.Name) を
Set rngTo = GetPasteCell(o.Name)に変更したら
メッセージは出なくなりましたが、こちらも同じく何も
変化がおこりません
やり方に問題があるかもしれません
ご教授お願いします
（燦燦） 2020/09/03(木) 16:33
Option Explicit
Sub メイン()
Dim o As PivotItem
Dim rngTo As Range
For Each o In Worksheets("ピボット").PivotTables(1).ColumnFields(1).PivotItems
o.DataRange.Select
MsgBox o.Name
Set rngTo = GetPasteCell(o.Name)
If Not rngTo Is Nothing Then
o.DataRange.Copy GetPasteCell(o.Name)
End If
Next
End Sub
Function GetPasteCell(ByVal sName As String) As Range
Dim rngTo As Range: Set rngTo = Worksheets("別シート").Rows(24).Cells
Dim ix As Long
On Error Resume Next
ix = WorksheetFunction.Match(sName, rngTo, 0)
On Error GoTo 0
If ix > 0 Then
Set GetPasteCell = rngTo(ix)
GetPasteCell.Select
MsgBox GetPasteCell.Address
Else
MsgBox sName & ": が見つかりませんでした。"
End If
End Function
失礼しました。
動作確認はしたつもりですが、
なんだかおかしなこと書いてましたね＾＾；
えっと、昼は外仕事、夜はデートでパソコンの前に座れてません。
上記のようにわざとセルを選択して可視化して確認してみてください。
あとステップインで実行しながら、
ローカルウィンドウで変数の中身を確認しながら、
意図通りに動いているか確認してください。
こちらが、そちらのシートの状態を把握できてないのが、
不具合の原因だとは思いますが、
その辺はそちらで微調整していただくしかないかと思いますので。
参考URL>>
http://www.ken3.org/vba/excel-help.html
（まっつわん） 2020/09/04(金) 08:31
シートの状態だと思うのですが「見つかりませんでした」となります
イミテッドウィンドウというのをやってみました
何が原因か分かりませんでした
あとローカルウィンドウもやってみました
意図とおりに動いているか恥ずかしながら分かりませんでした
メッセージはピポッドテーブルのN1がでます
別シートはN1は無いのでこれが原因だったりしますか？
あと、別シートは24行目より上には別のデーターやグラフがあります
こっちが原因ですかね？
o.DataRange.Select
↓
: DrilledDown : <アプリケーション定義またはオブジェクト定義のエラーです。> : Boolean
: Formula : <アプリケーション定義またはオブジェクト定義のエラーです。> : String
+ : Parent : : PivotField/PivotField
: ParentItem : <PivotItem クラスの ParentItem プロパティを取得できません。> : PivotItem
: StandardFormula : <アプリケーション定義またはオブジェクト定義のエラーです。> : String
On Error Resume Next
↓
+ : Cells : : Range/Range
: CommentThreaded : <アプリケーション定義またはオブジェクト定義のエラーです。> : CommentThreaded
: CurrentArray : <該当するセルが見つかりません。> : Range
（燦燦） 2020/09/08(火) 14:03
意味がわかりません。
色々ぼかして表現されているので、ぼんやりしか伝わらないです。
用語等で業種とかばれるかも知れませんが、
会社名や個人名以外なら、さほど問題にならない気がしますが。。。
僕の経験上できるだけ、ぼかしたり言い換えたりしない方が、
回答側に素直に伝わる気がします。
＞.ColumnFields(1).PivotItems
.ColumnFields(2).PivotItems
山勘ですが、上記のように直すと意図する値が表示されるかも知れません。
マクロ初挑戦ならちょっとサンプルを解読するのが難しいかも知れません。
アプローチを変えて、
Sub test2()
Dim i As Long
Dim j As Long
'5行目の一番右のデータがある列番号の取得
j = Worksheets("ピボットテーブル").Cells(5, Worksheets("ピボットテーブル").Columns.Count).End(xlToLeft).Column
For i = 5 To j
If IsEmpty(Worksheets("ピボットテーブル").Cells(5, i).Value) = False Then
Worksheets("ピボットテーブル").Cells(5, i).Select
MsgBox "項目名は：" & Worksheets("ピボットテーブル").Cells(5, i).Value _
& "セル番地は：" & Worksheets("ピボットテーブル").Cells(5, i).Address(False, False, , True)
End If
Next
End Sub
コピー元の基準のセルを順次探すマクロです。
まずはこの辺から少しづつ順番に勉強して覚えていくといいと思います。
これが意図通りできたら、
コピー元のセル範囲を基準のセルから相対位置で探していけばいいと思います。
ここの掲示板を毎日は見てないです。
申し訳ありません。
（まっつわん） 2020/09/12(土) 10:10
パット思いつき、別のシートにコピー元と同じ位置に張り付けて、貼り付けた物を想定する位置までずらす。 それをコピーして、貼り付けたいところに張り付け。 これで数式もずれるんじゃないかと？ 試してません。 （Why） 2020/09/12(土) 12:06
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.