【修正希望】【マクロ】元データから別表のランキング表へデータを抽出したい

tatsu99様

いつもお世話になっております。

以前、ご教授頂きました件で変更がございましたので
質問させていただきます。
↓
https://oshiete.goo.ne.jp/qa/10992933.html

module1
最優秀拠点部署

module3
最優秀拠点部署数量金額

module5
最優秀拠点部署売上金額

※module4、6については下記にて修正いただきました。
https://oshiete.goo.ne.jp/qa/11003131.html

別件で対象列が変動した場合についてご教授頂きましたが
再度、本件の場合についてもマクロのどの部分を修正すればよいのか？
ご教授頂けますと幸いです。

ひと月ごとの列数がC列から23列→41列へ変更。

対象列が下記へ変更となりました。
対象項目対象行には変更ございません。

計画　
数量/売上→O列
粗利→Q列

実績
数量/売上→AA列
粗利→AC列

数量/売上達成率→AM列
粗利達成率→AN列

お忙しいかと存じますが、何卒ご教授願います。

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

• 

  tatsu99様
  
  おはようございます。
  
  やはり確認しましたが、数字が入っております。
  第一四半期におきましては達成/未達成額の列がFJ列となります。

  No.16の回答に寄せられた補足コメントです。 補足日時：2019/12/12 08:59

No.9 ベストアンサー 回答者： tatsu99 回答日時： 2019/12/11 14:35

module5の修正点

１．ひと月ごとの列数がC列から23列→41列へ変更。
Private Function get_src_col_by_index(ByVal mx As Long)
をmodule1と同様に修正する。

２．項目対応の変更点
下記プロシージャの以下の個所を修正します。
Private Sub sheet_rank(ByVal ws1 As Worksheet, ByVal wbook As Workbook, ByVal trow As Long)
----------------------------------------
'全月分繰り返す
For i = 0 To UBound(month_flg)
'当該月インデックスの月が到来済みなら処理する
If month_flg(i) = True Then
src_col = get_src_col_by_index(i)
wk_col = get_work_col_by_index(i)
If IsNumeric(src_ws.Cells(trow, src_col + 6).Value) = False Then・・・・①
MsgBox ("数量不正")
src_ws.Cells(trow, src_col + 6).Select・・・・①
Application.Calculation = xlCalculationAutomatic
End
End If
'拠点
If src_ws.Range("A1").Value = 1 Then
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col).Value = src_name 'エリア／支店
Else
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 1).Value = src_name '店舗／課・営業所
End If
'20191001修正開始
'20191002修正開始
If src_ws.Cells(trow, src_col + 5).Value <> "" Then・・・・②
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 2).Value = _
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 2).Value + src_ws.Cells(trow, src_col + 5).Value '売上粗利計画・・・②
End If
If src_ws.Cells(trow, src_col + 8).Value <> "" Then・・・・③
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 3).Value = _
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 3).Value + src_ws.Cells(trow, src_col + 8).Value '売上粗利実績・・・③
End If
'達成率粗利
kei_val = ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 2).Value
jis_val = ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 3).Value
If kei_val = 0 Then
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 4).Value = ""
Else
If kei_val < 0 Then
If jis_val < kei_val Then
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 4).Value = Abs(jis_val) / kei_val
Else
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 4).Value = jis_val / Abs(kei_val) + 2
End If
Else
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 4).Value = jis_val / kei_val
End If
End If
'20191002修正終了
'20191001修正終了
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 5).Value = src_ws.Range("A1").Value 'A1の値（ソートに使用）
'対計画達成／未達成額 追加開始20190311
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 6).Value = _
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 3).Value - ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 2).Value
'対計画達成／未達成額 追加終了20190311
End If
Next
End If
--------------------------------------
上記の①～③の行について、以下の変更を行います。
①　2か所　6→24
②　2か所　5→14
③　2か所　8→26

以上で、完了です。

No.19 回答者： tatsu99 回答日時： 2019/12/12 17:25

>また、別途要望がございまして、どのようにしたらよいかお知恵をお借りできましたら幸いです。

>決まりましたら、ご質問させて頂きます。
了解しました。

この回答へのお礼

tatsu99様

お世話になっております。

追加でのご相談の件ですが、一旦保留となりました。
また、年内に何かございましたらご相談させてください。

本件含め、ご教授頂きましてありがとうございました。

お礼日時：2019/12/13 16:12

No.18 回答者： tatsu99 回答日時： 2019/12/12 11:47

ちなみに、

年間の最後の項目（伸長額対前年金額）はADA列です。
年間の「伸長額対計画金額」はACY列です。
ご確認ください。

No.17 回答者： tatsu99 回答日時： 2019/12/12 09:39

>第一四半期におきましては達成/未達成額の列がFJ列となります。

これは、あなたの提示された図の10月の伸長額対計画金額（AO列）のことですね。
そうであれば、第一四半期ではFH列（相対位置３８）ではないでしょうか。

この回答へのお礼

お世話になっております。

ご返信が遅くなり、申し訳ありません。

№５でご教授頂きましたように２２→38に修正したので、ご教授頂いた通りになっておりました。
また、再度検証しませいたところ、やはり月、Qによって金額が違っているようでした。。。
お騒がせして申し訳ございません。
再度元データを精査した上で検証したいと思います。

お手数をおかけして申し訳ございません。

また、別途要望がございまして、どのようにしたらよいかお知恵をお借りできましたら幸いです。
決まりましたら、ご質問させて頂きます。

お忙しい中、ご教授頂きましてありがとうございます。

お礼日時：2019/12/12 12:04

No.16 回答者： tatsu99 回答日時： 2019/12/11 21:06

到来月と設定される月の関係です。

参考までに。
到来月　設定される月
10　　　10,1Q,上半期、年間
11　　　10,11,1Q,上半期、年間
12　　　10,11,12,1Q,上半期、年間
1 　　　10,11,12,1Q,1,2Q,上半期、年間
2 　　　10,11,12,1Q,1,2,2Q,上半期、年間
3 　　　10,11,12,1Q,1,2,3,2Q,上半期、年間
4 　　　10,11,12,1Q,1,2,3,2Q,上半期、4,3Q,下半期,年間
5 　　　10,11,12,1Q,1,2,3,2Q,上半期、4,5,3Q,下半期,年間
6 　　　10,11,12,1Q,1,2,3,2Q,上半期、4,5,6,3Q,下半期,年間
7 　　　10,11,12,1Q,1,2,3,2Q,上半期、4,5,6,3Q,7,4Q,下半期,年間
8 　　　10,11,12,1Q,1,2,3,2Q,上半期、4,5,6,3Q,7,8,4Q,下半期,年間
9 　　　10,11,12,1Q,1,2,3,2Q,上半期、4,5,6,3Q,7,8,9,4Q,下半期,年間

この回答へのお礼

ご提示ありがとうございます。
今回11月まで到来月に設定しているので
11に該当するはずですよね？

お礼日時：2019/12/11 21:09

No.15 回答者： tatsu99 回答日時： 2019/12/11 19:45

念のため確認ですが、到来月は何月で試験されましたでしょうか。

例えば到来月＝１０月の場合、設定されるのは、
第一4半期、上半期、年間のみです。第二四半期、第三四半期などは設定されません。
このことは認識されてますでしょうか。

この回答へのお礼

申し訳ありません。
認識しておりませんでした(›´A`‹ )

明日、再度確認させていただきます。

ありがとうございます。

お礼日時：2019/12/11 20:40

No.14 回答者： tatsu99 回答日時： 2019/12/11 19:02

>module1なのですが、ひと月分の達成/未達成額は表示されるのですが

>第一、第二、第三四半期、上半期、下半期、年間の部分が０になってしまいます。

元データの第一、第二、第三四半期、上半期、下半期、年間の達成/未達成額が設定されていないと思われます。
元データに上記項目が設定されていないと、０になります。
以前の処理でも、同じことが起こると思いますが、いかがでしょうか。

この回答へのお礼

お世話になっております。

わたしも元データ確認したのですが
元データには入っておりました。

明日、もう一度確認させていただきまして、ご報告させていただきます。

もし、元データに入っているのに表示されないのはわたしの修正に誤りがある可能性がありますでしょうか？

お礼日時：2019/12/11 19:23

No.13 回答者： tatsu99 回答日時： 2019/12/11 16:08

修正個所は以下のようになります。

If src_ws.Cells(176, src_col + 21).Value <> "" And IsNumeric(src_ws.Cells(176, src_col + 21).Value) = False Then・・・①
MsgBox ("経常利益達成率不正")
src_ws.Cells(176, src_col + 21).Select
Application.Calculation = xlCalculationAutomatic
End
End If
'20191001修正開始
'経常利益
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col).Value = src_name 'エリア／支店
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 1).Value = _
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 1).Value + src_ws.Cells(176, src_col + 5).Value '粗利計画
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 2).Value = _
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 2).Value + src_ws.Cells(176, src_col + 8).Value '粗利実績
If src_ws.Cells(176, src_col + 21).Value <> "" Then・・・②開始
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 3).Value = _
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 3).Value + src_ws.Cells(176, src_col + 21).Value '達成率対計画金額
End If・・・②終了
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 4).Value = _
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 4).Value + src_ws.Cells(176, src_col + 22).Value '伸長額対計画金額
If src_ws.Cells(181, src_col + 21).Value <> "" And IsNumeric(src_ws.Cells(181, src_col + 21).Value) = False Then・・・③
MsgBox ("収支　合計達成率不正")
src_ws.Cells(181, src_col + 21).Select
Application.Calculation = xlCalculationAutomatic
End
End If
'収支　合計
ThisWorkbook.Worksheets(wn2).Cells(wk_row, wk_col).Value = src_name 'エリア／支店
ThisWorkbook.Worksheets(wn2).Cells(wk_row, wk_col + 1).Value = _
ThisWorkbook.Worksheets(wn2).Cells(wk_row, wk_col + 1).Value + src_ws.Cells(181, src_col + 5).Value '粗利計画
ThisWorkbook.Worksheets(wn2).Cells(wk_row, wk_col + 2).Value = _
ThisWorkbook.Worksheets(wn2).Cells(wk_row, wk_col + 2).Value + src_ws.Cells(181, src_col + 8).Value '粗利実績
If src_ws.Cells(181, src_col + 21).Value <> "" Then・・・④開始
ThisWorkbook.Worksheets(wn2).Cells(wk_row, wk_col + 3).Value = _
ThisWorkbook.Worksheets(wn2).Cells(wk_row, wk_col + 3).Value + src_ws.Cells(181, src_col + 21).Value '達成率対計画金額
End If・・・④終了
ThisWorkbook.Worksheets(wn2).Cells(wk_row, wk_col + 4).Value = _
ThisWorkbook.Worksheets(wn2).Cells(wk_row, wk_col + 4).Value + src_ws.Cells(181, src_col + 22).Value '伸長額対計画金額


①，②、③、④になります。
（21は37に置き換えてください）
①、③は1行のみです。
①、③は、空白以外でかつ数字でないならエラーにするようにしました。（よって空白はえらーにならない）
②、④は、空白のデータを加算するとエラーになるので、空白でないなら加算するようにしました。
・・・①などの「・・・①」の文字は実際にはマクロにはつけないでください。

②、④は、if文なのでインデントを付けます。（投稿時、空白が削除されるので見た目ではインデントがついていませんが）
②は
If src_ws.Cells(176, src_col + 21).Value <> "" Then・・・②開始
　　ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 3).Value = _
　　ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 3).Value + src_ws.Cells(176, src_col + 21).Value '達成率対計画金額
End If・・・②終了
のように、コーディングしてください。（意図的に全角空白を入れています。全角空白があるので、この個所はコピペしないでください。）

他の列も空白があれば、エラーになる可能性がありますが、とりあえず、まずは、AN列の対応のみ行います。

この回答へのお礼

本件、諸々ご教授頂きましてありがとうございます。
理解しながら私のほうで修正いたしましたが
module1なのですが、ひと月分の達成/未達成額は表示されるのですが
第一、第二、第三四半期、上半期、下半期、年間の部分が０になってしまいます。

何が考えられるでしょうか？

お礼日時：2019/12/11 18:12

No.12 回答者： tatsu99 回答日時： 2019/12/11 15:18

>１．メッセージボックスに「経常利益達成率不正」と表示されます。

AN列に空白が設定されている可能性があります。
ANへ
=IFERROR(xxx,"")のように
""（ダブルクート２つ）で空白を設定すると、エラーになります。
マクロで対応するのは可能ですが、このエラーは、今までは、出ていなかったはずです。
今までの粗利達成率算出の計算式が変わったのでしょうか。
今までのX列の式と、今回のAN列は、同じ考え方であれば、””の空白にはならないはずなのですが。

この回答へのお礼

お仰る通り、=IF(ISERROR(AA6/O6),"",AA6/O6)の数式が入っております。
以前は値で貼り付けられていたので、その際修正頂いたように認識しております。
回避できるように修正頂くことは可能でしょうか？
お手数をおかけして申し訳ありませんが、よろしくお願いいたします。

お礼日時：2019/12/11 15:36

No.11 回答者： tatsu99 回答日時： 2019/12/11 15:02

エラーは

１．メッセージボックスに「経常利益達成率不正」又は「収支　合計達成率不正」がでるエラーですか？
２．それとも、途中で止まってしまうエラーですか？

１なら、AN列が不正の意味です。
「AM列のみ集計項目によって、空白になっていたり数式が入っていたりまちまちになっている為」
とありますが、AM列はこの時点で、参照していないのでエラーになりません。

まず、どちらのエラーなのかを確認させてください。

この回答へのお礼

何度も申し訳ございません。

エラーは
１．メッセージボックスに「経常利益達成率不正」と表示されます。

お礼日時：2019/12/11 15:10