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

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.10 回答者： tatsu99 回答日時： 2019/12/11 14:41

>ただ、経常利益達成率が元データ空白な為、エラーになってしまいます。

。。
>解決方法はございますでしょうか？
経常利益達成率とは、「粗利達成率→AN列」のことでしょうか？

この回答へのお礼

説明不足で申し訳ありません。
AM列のみ集計項目によって、空白になっていたり数式が入っていたりまちまちになっている為
エラーが出てしまっていると思います。

お礼日時：2019/12/11 14:48

No.8 回答者： tatsu99 回答日時： 2019/12/11 14:29

追伸：

No7のmodule3の修正点
２．項目対応の変更点は、下記プロシージャ内のマクロの説明です。
Private Sub sheet_rank(ByVal ws1 As Worksheet, ByVal wbook As Workbook, ByVal trow As Long)

No.7 回答者： tatsu99 回答日時： 2019/12/11 14:24

module3の修正点

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

２．項目対応の変更点
----------------------------------------
'全月分繰り返す
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 + 3).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 + 3).Value '数量計画・・・②
End If
If src_ws.Cells(trow, src_col + 6).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 + 6).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
ThisWorkbook.Worksheets(wn1).Cells(wk_row, wk_col + 4).Value = jis_val / kei_val
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
----------------------------------------
上記の①～③の行について、以下の変更を行います。
①　2か所　6→24
②　2か所　3→12
③　2か所　6→24
（尚、①と③は同じ項目ですが、①はチェック用に使用しているので分けています）

No.6 回答者： tatsu99 回答日時： 2019/12/11 14:17

すみません。

変更箇所の①～⑤の説明の追記です。
①を例にとると
If IsNumeric(src_ws.Cells(176, src_col + 21).Value) = False Then・・・・・・・①
とありますが、
src_wsは元データのシートを示しています。したがって、src_ws.Cells(xxx,yyy)の個所が修正対象です。(xxx,yyyは数式又は数値)
src_ws.がないのは元データのシートではないので修正対象にはなりません。

src_ws.Cells(176, src_col + 21)は
元データシートの１７６行目のsrc_col + 21列を参照しています。
src_colは処理対象の月によって変わりますが、その月の開始の列を示しています。
従って、src_col + 21は、その月の粗利達成率を参照していることになります。
よってこの21を37に変えればよいことになります。

module3,5も同じですが、変更対象になるのは、src_ws.Cells(xxx,yyy)の個所のみであるということに留意してください。

No.5 回答者： tatsu99 回答日時： 2019/12/11 13:59

今までは、私のほうで修正し、動作確認後、マクロをリリースしていましたが、

今回は、変更内容を理解するために、あなたのほうで、マクロを直接修正する形で作業を進めたいと思います。
module1、３，５の順に、動作確認しながら、進めてください。

module1の修正点
１．ひと月ごとの列数がC列から23列→41列へ変更。への対応箇所
'月のindexから先頭のカラム位置を取得（元データファイルのシート）
Private Function get_src_col_by_index(ByVal mx As Long)
get_src_col_by_index = 3 + mx * 23・・・・・・①
End Function
①の２３を４１に修正する。

２．各項目の変更対応箇所
Private Sub sheet_rank(ByVal mode As Long, ByVal ws1 As Worksheet, ByVal ws2 As Worksheet, ByVal wbook As Workbook)
の以下の個所を変更
-----------------------------------------
'全月分繰り返す
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(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 '粗利実績・・・③
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 '達成率対計画金額・・・④
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 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 '粗利実績・・・③
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 '達成率対計画金額・・・④
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 '伸長額対計画金額・・・⑤
'20191001修正終了
End If
Next
----------------------------------------
上記の①～⑤の行について、以下の変更を行います。
①　4か所　21→37
②　2か所　5→14
③　2か所　8→26
④　2か所　21→37
⑤　2か所　22→38
（尚、①と④は同じ項目ですが、①はチェック用に使用しているので分けています）

以上となります。

この回答へのお礼

ご教授頂きましてありがとうございます。
ご丁寧にご説明頂きありがとうございます。
ただ、経常利益達成率が元データ空白な為、エラーになってしまいます。。。
解決方法はございますでしょうか？

お礼日時：2019/12/11 14:35

No.4 回答者： tatsu99 回答日時： 2019/12/11 13:33

変更後のレイアウトです。

同様に変更対象のセルの相対番号ですが、
１２，１４、２４，２６、３６、３７、３８となります。（１０月分）
11月分は、AR列が０になります。

変更前と変更後のセル位置を相対番号に注目すると以下のようになります。
計画　
数量/売上　　F列(3)→O列(12)
粗利　　　　 H列(5)→Q列(14)

実績
数量/売上　　I列(6)→AA列(24)
粗利　　　　 K列(8)→AC列(26)

数量/売上達成率　　W列(20)→AM列(36)
粗利達成率　　　　 X列(21)→AN列(37)

伸長額対計画金額　Y列(22)→AO列(38)

カッコ内の数値が相対番号です。修正個所は、この数値が元になります。

No.3 回答者： tatsu99 回答日時： 2019/12/11 13:27

変更前のレイアウトですが、添付画像を参照ください。

変更対象の項目名が赤のセルになっています。
上記の項目対応の相対番号が２行目の数値に示されています。
計画　
数量/売上　　F列(3)
粗利　　　　 H列(5)
実績
数量/売上　　I列(6)
粗利　　　　 K列(8)
数量/売上達成率　　W列(20)
粗利達成率　　　　 X列(21)
伸長額対計画金額　Y列(22)

この３，５，６，８，２０，２１，２２は
C列を０として、順に振った番号です。（10月分）
11月になれば、Z列が０になります。
この数値を覚えておいてください。
画像が小さくなるので、変更後の画像は次回の投稿になります。

No.2 回答者： tatsu99 回答日時： 2019/12/11 11:32

一点、追記です。

下記項目も集計対象になっています。ご確認ください。
module1（最優秀拠点部署）で使用しています。
伸長額対前年金額　Y列→AQ列

この回答へのお礼

ご返信頂きましてありがとうございます。

>一点、追記です。下記項目も集計対象になっています。ご確認ください。
>module1（最優秀拠点部署）で使用しています。
>伸長額対前年金額　Y列→AQ列
→前回、お伝えした内容が間違っていたようです。
大変失礼いたしました。
正しくは伸長額対計画金額　Y列→AO列となります。

よろしくお願いいたします。

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

No.1 回答者： tatsu99 回答日時： 2019/12/11 10:55

念のため確認です。

各項目の変更前の列を追記しました。下記で間違いないでしょうか。
計画　
数量/売上　　F列→O列
粗利　　　　 H列→Q列

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

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

この回答へのお礼

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

前回の列を記載せず、申し訳ございません。
記載頂いた内容で問題ございません。

よろしくお願いいたします。

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