元データ(ピボッド)を開かずマクロで更新したい(続き)

下記より質問させて頂いた内容の続きになります。(補足上限達した為)
https://oshiete.goo.ne.jp/qa/9768603.html

---------------------------------------------------------------------------------------------------------tatsu99さまよりご回答いただいた件、回答いたします。
↓
>>№37で実行しましたところ、こちらで記載頂いたエラーがでました。。。
>では、本当に、指定されたファイルがないということになります。
>拡張子も含めて、合ってますか。
>管理シートでAAA.xlsm を指定し実際のファイルはAAA.xlsxだったなどということはないでしょう>>か。
→拡張子は相違ありません。

>もし、間違いなければ、
>あなたが指定したファイルが間違いなく存在するというエビデンス（証拠）の提示をお願いします。
>添付図の①のように、管理シートで、指定したD2,E2の内容の画像
>添付図の②のように、上記のファイルが存在するディレクトリに移動し、
>コマンドプロンプトで、dir を実行し、指定したファイル名が表示されることの確認。
>（特に、赤字で囲んだ箇所が、間違いないか確認し、その箇所を含んだ画像を提示しください）
>鮮明な画像の提示をお願いします。
>第三者がみれば、間違いに気づく可能性があります。
> 操作で不明な点があれば、補足ください。
→指定したファイルが表示されませんでした。
画像添付いたしますので、ご確認願います。
---------------------------------------------------------------------------------------------------------

質問者からの補足コメント

• コマンドプロンプトの画像添付いたします。
  ※すみません、PC情報となる箇所は黒く塗りつぶしています。

  
    補足日時：2017/06/07 11:36

• №4で№5の質問をしております。
  文字数の兼ね合いでこちらに続きを記載いたします。
  
  ②の件
  実行時エラー’53’
  ファイルが見つかりません。
  
  '売上明細ブック名設定
  Uri_path = Jis_folder & "\" & Uri_book
  MsgBox ("ファイル名<" & Uri_book & ">") '追加①
  MsgBox ("フルパス名<" & Uri_path & ">") '追加②
  MsgBox (GetAttr(Uri_path)) '追加③

  No.5の回答に寄せられた補足コメントです。 補足日時：2017/06/08 17:16

• ※コマンドプロントの画像添付します。

  
  No.15の回答に寄せられた補足コメントです。 補足日時：2017/06/09 10:07

• サンプル画像添付します。

  
  No.24の回答に寄せられた補足コメントです。 補足日時：2017/06/14 15:54

No.16 回答者： tatsu99 回答日時： 2017/06/09 09:45

最終的には添付画像のようになります。

赤線内を確認してください。

No.15 回答者： tatsu99 回答日時： 2017/06/09 09:41

＞→申し訳ありません。

テストで作成したフォルダのコマンドプロントはどのようにすればよいでしょうか？
　今のPCのアカウントで出てきてしまいます。いろいろと調べたのですが切り替えの方法がわかりかねております。

１）コマンドプロンプトを起動します。
２）cd \
これで C:\>
がひょうじされます。
3) cd TESTDIR
これで
C:\TESTDIR> が表示されます
４）dir
これで、このディレクトリ下のファイル及びディレクトリがひょうじされます。
<DIR> 実績
が表示されればOKです。
５）cd 実績
これで
C:\TESTDIR\実績> が表示されます。
６）dir
2017.xlsx
が表示されればOK
もし、2016.xslxがあればそれも表示されます。

この回答へのお礼

ご教授頂きましてありがとうございます。
確認しましたところ、拡張子が重複していることが問題のようです。
なぜか、エクセルファイルで保存すると拡張子が付いたり付かなかったりするのですが、もちろん保存するときは
.xlsxで保存しているのですが表示上拡張子が現れず、私が手入力しておりました。
マクロで読み込ませるとそれは.xlsxと認識される為、エラーが出てしまっていたと考えます。
念の為、画像添付させて頂きます。
また、2017(本年)実績データを読み込ませると2016(前年)実績データでは現れない表示が出てきました。
この表示内容はどのような意味でしょうか？
上の部分のエラーはその月に実績がないのでと理解できるのですが、下の部分のエラーについては上の内容と表示内容が異なるので
恐れ入りますが、ご教授頂ければ幸いです。

お礼日時：2017/06/09 09:57

No.14 回答者： tatsu99 回答日時： 2017/06/08 19:24

＞Uri_book = "2017.xlsx" '追加④

＞Uri_path = "C:\TESTDIR\実績\2017.xlsx" '追加⑤
これで、エラーがブックのオープンエラーがでるということですが、2016.xslxでは成功しているので、
マクロの問題ではなく、環境の問題になります。すこしずつ、範囲を狭めて、正しい設定を確認するしかありません。
考えられるのは、①②の何れかです。

①C:\TESTDIR\実績
のフォルダが実在しないか、指定が間違っている。
そのフォルダの下にコマンドプロンプトで移動できるか確認する。

②2017.xlsx
このファイルが実在しないか、指定が間違っている。
①がOKなら、フォルダの下に移動し、dirコマンドで2017.xlsxが表示されるか確認する。

確認ですが、
C:\TESTDIR\実績 このフォルダは、2016.xlsxで試験したフォルダと同じですか。
それとも、2017.xlsxになって、このフォルダにしたのですか。

この回答へのお礼

>＞Uri_book = "2017.xlsx" '追加④
>＞Uri_path = "C:\TESTDIR\実績\2017.xlsx" '追加⑤
>これで、エラーがブックのオープンエラーがでるということですが、2016.xslxでは成功しているので、
>マクロの問題ではなく、環境の問題になります。すこしずつ、範囲を狭めて、正しい設定を確認するしかありません。
> 考えられるのは、①②の何れかです。

>①C:\TESTDIR\実績
>のフォルダが実在しないか、指定が間違っている。
>そのフォルダの下にコマンドプロンプトで移動できるか確認する。
→申し訳ありません。テストで作成したフォルダのコマンドプロントはどのようにすればよいでしょうか？
　今のPCのアカウントで出てきてしまいます。いろいろと調べたのですが切り替えの方法がわかりかねております。

②2017.xlsx
このファイルが実在しないか、指定が間違っている。
①がOKなら、フォルダの下に移動し、dirコマンドで2017.xlsxが表示されるか確認する。
→①に併せて、お手数ではございますが確認方法をご教授願います。

> 確認ですが、
>C:\TESTDIR\実績 このフォルダは、2016.xlsxで試験したフォルダと同じですか。
>それとも、2017.xlsxになって、このフォルダにしたのですか。
→2016と同じフォルダに入れてあります。

お礼日時：2017/06/09 09:32

No.13 回答者： tatsu99 回答日時： 2017/06/08 14:45

まだ残っているのは、新旧判定をおこなわないケースですが、

ws.Cells(29, col).Value = GetValue(HON1sheet, "K", "H", "1", "", "", HON1dicT, HON1Rows) 'I
は、うまく処理できていますか。
もし、これも、処理できていないなら、新旧判定を無視する処理（col2=""の扱い）に問題がありそうです。
もし、これが、処理できているなら、データ（ピボットのシート）に問題がありそうです。

No.12 回答者： tatsu99 回答日時： 2017/06/08 14:15

>書式設定を開くと一番上の「標準」になっています。

であれば、問題なさそうですね。
以下のプロシージャですが、数値でも文字でもどちらでもできるようにしました。
元のをバックアップをとって、このプロシージャのみ、そっくり入れ替えて試験していただけますか。
---------------------------------------------------------------------------
'ピボットシートから値を取得する
Private Function GetValue(ByVal sheet_name, ByVal g_col As String, ByVal col1 As String, ByVal val1 As Variant, ByVal col2 As String, ByVal val2 As Variant, ByVal dicT As Object, ByRef TRows() As Long) As Variant
Dim ix As Long
Dim j, row, ctr As Long
Dim gval As Variant 'PVシートから取得した集計対象値
Dim gval1 As Variant 'PVシートから取得した条件値
Dim gval2 As Variant 'PVシートから取得した新規判定値
GetValue = Empty '取得値初期化
'担当者のデータがないなら終了
If dicT.exists(trg_key) = False Then Exit Function
'担当者の添字とシート名を決定
ix = dicT(trg_key)
ctr = TRows(ix, 0)
'該当する行の数ぶん繰り返す
For j = 1 To ctr
row = TRows(ix, j) '行番号取得
'値を取得する
gval = Workbooks(Uri_book).Worksheets(sheet_name).Cells(row, g_col).Value
'取得値が空白でなく、かつ、取得条件が成立するなら、加算する
If gval <> "" Then
'取得したデータが数字でない場合は、エラー表示後、処理を打ち切る
If IsNumeric(gval) = False Then
MsgBox ("不正データ検出。以下のデータを正しく修正して下さい。処理を打ち切ります。")
MsgBox ("ブック名[" & Uri_book & "] シート名(" & sheet_name & ")" & " 行番号=" & row & " 列=" & g_col)
MsgBox (gval)
Workbooks(Uri_book).Activate
Workbooks(Uri_book).Worksheets(sheet_name).Activate
Workbooks(Uri_book).Worksheets(sheet_name).Cells(row, g_col).Select
End
End If
'条件の値を取得
gval1 = Workbooks(Uri_book).Worksheets(sheet_name).Cells(row, col1).Text
'実績かつ新規条件のカラムが指定された場合のみ、新規条件の値を取得
If col2 = "" Then
'新規条件が指定されない場合は共にEmptyを設定し、強制的に新規条件を成立させる
gval2 = Empty
val2 = Empty
Else
'新規条件
gval2 = Workbooks(Uri_book).Worksheets(sheet_name).Cells(row, col2).Text
End If
'条件及び新規条件が成立するなら加算する（新規条件を使用しない場合は、強制的に新規条件を一致させていることに注意）
If gval1 = val1 And gval2 = val2 Then
GetValue = GetValue + gval
End If
End If
Next
End Function
-----------------------------------------------------

この回答へのお礼

再度、ご教授頂きましてありがとうございます。
上記、マクロに変更して正しく集計されたようです。
ただ、現時点前年分しかテストしていない為、引き続き本年分のファイルでテストをしてみます。

お礼日時：2017/06/08 15:22

No.11 回答者： tatsu99 回答日時： 2017/06/08 12:39

>→テストとして2ファイルで処理をしましたが、29.51563秒でした。

1ブックで約１５秒なので、
１５秒×１７ブック＝２５５秒（約4~５分）なので、問題ないかと思いますが、
もし、大幅におくれるようなら、
Public Sub 売上月単位集計()の下の方に以下の2行を追加してください。

t1 = Timer
warnP = ""
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual '追加A
'売上明細ブック名オープン
Workbooks.Open Uri_path
Workbooks(Uri_book).Activate
'ピボットデータ読み込み
Call readPivot(HON1sheet, HON1dicT, HON1Rows)
Call readPivot(HON2sheet, HON2dicT, HON2Rows)
Call readPivot(HON3sheet, HON3dicT, HON3Rows)
'計画フォルダ内の全ブックを更新する
Call UpdateAllBooks(Kei_folder)
Workbooks(Uri_book).Close
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic '追加B
t2 = Timer


下記の2行が追加されたものです。
Application.Calculation = xlCalculationManual '追加A
Application.Calculation = xlCalculationAutomatic '追加B
ちなみに、これは、excelの自動再計算を一時的に止めて、その後、もとに戻しています。

又、その上の行の
Application.ScreenUpdating = False
Application.ScreenUpdating = True

ですが、マクロ実行中の画面の表示を止めて、その後、もとに戻しています。
処理速度をあげたい場合は、上記の行を追加すると、劇的に改善する場合があります。
（改善しない場合もありますが・・・）
今後、遅い場合は試してください。
（他のマクロでも同じようにできます。処理の頭と処理が終わった後に上記の行をいれるようにします）

この回答へのお礼

ご丁寧にアドバイス頂きまして感謝いたします。
速度を上げたい場合は、こちらを使用させて頂きます。
ありがとうございます。

お礼日時：2017/06/08 14:09

No.10 回答者： tatsu99 回答日時： 2017/06/08 11:41

'3部集計'

ws.Cells(8, col).Value = GetValue(HON3sheet, "I", "G", "1", "", "", HON3dicT, HON3Rows) '①
ws.Cells(9, col).Value = GetValue(HON3sheet, "I", "G", "2", "", "", HON3dicT, HON3Rows) '②
ws.Cells(19, col).Value = GetValue(HON3sheet, "I", "G", "6", "", "", HON3dicT, HON3Rows) 'D
ws.Cells(20, col).Value = GetValue(HON3sheet, "I", "G", "7", "", "", HON3dicT, HON3Rows) 'E
ws.Cells(21, col).Value = GetValue(HON3sheet, "I", "G", "8", "", "", HON3dicT, HON3Rows) 'F
'2部集計
回答：
ピボットのG列の1,2,6,7,8が文字列になっていませんか。念のため確認をお願いします。
空白は関係ありません。（そもそも、H列をみないので）

ws.Cells(31, col).Value = GetValue(HON2sheet, "H", "B", "4", "", "", HON2dicT, HON2Rows) 'J
ws.Cells(32, col).Value = GetValue(HON2sheet, "H", "B", "5", "", "", HON2dicT, HON2Rows) 'K
ws.Cells(33, col).Value = GetValue(HON2sheet, "I", "B", "6", "", "", HON2dicT, HON2Rows) 'L
回答：
ピボットのB列の4,5,6が文字列になっていませんか。念のため確認をお願いします。

この回答へのお礼

書式設定を開くと一番上の「標準」になっています。

お礼日時：2017/06/08 14:05

No.9 回答者： tatsu99 回答日時： 2017/06/08 10:55

>おっしゃる通り、””、空白どちらでもなく「(空白)」で表示されております。

"(空白)"の文字が表示されているということですか？
それであれば、
ws.Cells(10, col).Value = GetValue(HON3sheet, "I", "G", "3", "H", "", HON3dicT, HON3Rows) 'A既存
を
ws.Cells(10, col).Value = GetValue(HON3sheet, "I", "G", "3", "H", "(空白)", HON3dicT, HON3Rows) 'A既存

のように修正して下さい。（他の既存も同様です）

尚、（空白）の両端の()が全角なのか半角なのかこちらではわかりませんので、そこは同じように合わせてください。

この回答へのお礼

ご返信頂きましてありがとうございます。(空白)の既存の部分は修正したところ正しく集計できるようになりました。ご教授頂き、ありがとうございます。
ただ、下記の部分が正しく処理されません。こちらも(空白)が原因でしょうか？何卒、ご教授願います。

'個人シートに値の設定を行う
　 '3部集計'
ws.Cells(8, col).Value = GetValue(HON3sheet, "I", "G", "1", "", "", HON3dicT, HON3Rows) '①
ws.Cells(9, col).Value = GetValue(HON3sheet, "I", "G", "2", "", "", HON3dicT, HON3Rows) '②
ws.Cells(19, col).Value = GetValue(HON3sheet, "I", "G", "6", "", "", HON3dicT, HON3Rows) 'D
ws.Cells(20, col).Value = GetValue(HON3sheet, "I", "G", "7", "", "", HON3dicT, HON3Rows) 'E
ws.Cells(21, col).Value = GetValue(HON3sheet, "I", "G", "8", "", "", HON3dicT, HON3Rows) 'F
'2部集計
ws.Cells(31, col).Value = GetValue(HON2sheet, "H", "B", "4", "", "", HON2dicT, HON2Rows) 'J
ws.Cells(32, col).Value = GetValue(HON2sheet, "H", "B", "5", "", "", HON2dicT, HON2Rows) 'K
ws.Cells(33, col).Value = GetValue(HON2sheet, "I", "B", "6", "", "", HON2dicT, HON2Rows) 'L

お礼日時：2017/06/08 11:35

No.8 回答者： tatsu99 回答日時： 2017/06/08 09:45

集計条件として参照する列の値ですが、（3部集計時のG列、H列の値等）

G列は、1,2,3,4,等が①②AB等の項目の集計時の条件
H列は、1が新規集計時の条件
になっていますが、これらは、数値として格納されていることが前提です。
文字として格納されていた場合は、集計対象になりません。
添付図はG列が数値として格納、H列が文字として格納した状態を示しています。
もし、文字として格納しているなら、その旨下さい。（マクロの修正が必要になります）

この回答へのお礼

ご質問頂きありがとうございます。
確認しましたところ、数値での表記になっております。

お礼日時：2017/06/08 10:14

No.7 回答者： tatsu99 回答日時： 2017/06/08 04:14

>ピボッドの各部の新規列が1か(空白)という表示になっております

この（空白）という意味は、何も表示されていないという意味であれば、既存の集計対象です。
添付図でA1が集計対象、A2,A3は集計対象外です。

この回答へのお礼

おっしゃる通り、””、空白どちらでもなく「(空白)」で表示されております。
この表記を空欄””とするか「(空白)」とするか？ということになりますでしょうか？

お礼日時：2017/06/08 10:15