質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.35%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

1回答

1017閲覧

ピポットテーブル作成

gaku1115

総合スコア2

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2021/09/11 08:41

前提・実現したいこと

現在大学院に通う理系学生です.初めて質問させていただきます.

研究の実験のデータ整理用にマクロを組んでみようと思い,
現在作業中なのですがどうしても解決できない部分があるので
皆様のお力添えを頂きたいと思い投稿しました.
初めてのプログラミングなので温かい目で見て頂けると幸いです.

プログラムの内容

プログラムの内容は,
実験装置からエクスポートしたデータを
コピーしてきた,作成済みのテンプレートのシートに貼り付けて,
そのシートで処理したデータから
ピポットテーブルを作成するというものです.

コード

Sub ピポット作成まで()

'原本シートコピ-------------------------------------------------

'マクロ実行元
Dim macroWb As Workbook

'インポート先
Dim importWb As Workbook
Dim importPath As String

'マクロを実行元のWorkbook
Set macroWb = ThisWorkbook

'インポート先の文字列を取得
importPath = "C:\Users\Takuto Ichihara\Desktop\VBA\データ整理原本.xlsm"

'データをインポート(シートの内容をコピー)
Set importWb = Workbooks.Open(importPath)
importWb.Worksheets("u").Copy after:=macroWb.Sheets(1) 'Afterの場合、指定したシートの後ろに
importWb.Worksheets("u'rms").Copy after:=macroWb.Worksheets("u")
importWb.Worksheets("v").Copy after:=macroWb.Worksheets("u'rms")
importWb.Worksheets("元データ 貼り付け").Copy after:=macroWb.Worksheets("v")
importWb.Close

'保存しないが保存済みとみなし,ダイアログを非表示にする
Me.Saved = True

'元データ貼り付け-------------------------------------------------
Sheets(1).Activate

' 最終行の取得
Dim LASTROW As Long
LASTROW = Cells(Rows.Count, 1).End(xlUp).Row

'データコピペ
Range(Cells(9, 1), Cells(LASTROW, 6)).Copy

Worksheets("元データ 貼り付け").Activate ActiveSheet.Paste Destination:=Range("a5") Application.CutCopyMode = False

'数値入力ダイヤログ----------------------------------------
Dim ans幅 As String '容器幅入力
ans幅 = InputBox("容器幅", "データ入力", "")

If ans幅 <> "" Then Range("b1").Value = ans幅 End If Dim ans深さ As String '容器深さ入力 ans深さ = InputBox("容器深さ", "データ入力", "") If ans深さ <> "" Then Range("b2").Value = ans深さ End If Dim ansx As String '座標中心x入力 ansx = InputBox("座標中心x", "データ入力", "") If ansx <> "" Then Range("d1").Value = ansx End If Dim ansy As String '座標中心y入力 ansy = InputBox("座標中心y", "データ入力", "") If ansy <> "" Then Range("h1").Value = ansy End If Dim ansU0 As String '流速入力 ansU0 = InputBox("流速", "データ入力", "") If ansU0 <> "" Then Range("d2").Value = ansU0 End If

'ピポットテーブルの作成------------------------------------
'u
' 最終行の取得
Dim lastlow As Long
lastlow = Cells(Rows.Count, 1).End(xlUp).Row

' ピボットテーブル用のシート追加 Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "ピボットu" ' 変数を宣言

Dim pvc As PivotCache

' ピボットキャッシュを作成して変数に格納
Set pvc = ThisWorkbook.PivotCaches.Create(xlDatabase, Worksheets("元データ 貼り付け").Range(Cells(5, 7), Cells(lastlow, 12)))

' ピボットテーブルを作成
pvc.CreatePivotTable Sheets("ピボットu").Range("A1"), "ピボットu"

' フィールドを設定 With ActiveSheet.PivotTables("ピボットu") .PivotFields("y/D").Orientation = xlRowField .PivotFields("x/H").Orientation = xlColumnField .PivotFields("u/Uo").Orientation = xlDataField ' ピボットテーブルの総計を非表示に()

With ActiveSheet.PivotTables(1)
.ColumnGrand = False
.RowGrand = False
End With

End With

End Sub

エラー

' ピボットキャッシュを作成して変数に格納
Set pvc = ThisWorkbook.PivotCaches.Create(xlDatabase, Worksheets("元データ 貼り付け").Range(Cells(5, 7), Cells(lastlow, 12)))

この部分で
「実行時エラー'1004':アプリケーション定義またはオブジェクト定義のエラーです.」

とのエラーが出てしまいます.

ネットで調ながらやってきたのですが,自分では解決できませんでした.

試したこと

cells(lastlow,12)))
の部分が悪いのかなと考え,範囲に名前を付けてりして試してみたのですが,
自分では解決できませんでした.

終わりに

プログラム初心者なので,至らない点がたくさんあると思います.
これから勉強していきたいと思っておりますので,
温かい目で見て頂けると幸いです.

また,教えて頂けるのであれば
問題が発生していない部分でも改善点などがあれば教えて頂きたいです.
どうしてこのコードになるのか,このコードはどういう意味なのかも教えて頂ければ
とても勉強になり,うれしいです.

お願い事が多くて恐縮なのですが,よろしくお願い致します.

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

「Worksheets("元データ 貼り付け")」がマクロブックとインポート用ブックの療法にあるようなのですが、

以下の部分で、元になるブックおよびシートが明確で無いものがあるので、 そこを明確にしてみてください。

VBA

1Set pvc = ThisWorkbook.PivotCaches.Create (xlDatabase, Worksheets("元データ 貼り付け").Range(Cells(5, 7), Cells(lastlow, 12)))

以下に修正

VBA

1Dim sh As Worksheet 2Set sh = macroWb.Worksheets("元データ 貼り付け") 3Set pvc = ThisWorkbook.PivotCaches.Create(xlDatabase, sh.Range(sh.Cells(5, 7), sh.Cells(lastlow, 12)))

※対象のシートをひとまずマクロブックにしています。違ったらすみません。
※コードが長くなるので変数shを用意しています。
※Rangeの中をCellsで指定する場合は「親」の指定に注意してください。

投稿2021/09/13 08:10

hex309

総合スコア761

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

gaku1115

2021/09/13 08:28

ありがとうございます! 上手くいきました! これで研究が捗りそうです.
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.35%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問